Boucle for copie coller cellule

she -
she - 7 juil. 2014 à 11:06

Bonjour,

j'ai fait une boucle for qui me permette normalement de copier des cellule précise d'un classeur vers un autre autre classeur mais ma boucle x ne marche pas
j'aimerai qu'il parte de la ligne 114 et m'incremente de 112 ligne en plus pour chaque cellule du tableau cible (qui est ici representé par la boucle y qui marche)
en faite je pense que ma boucle x me boucle tout d'un coup et me donne la derniere valeur copié du classeur.

comment faire pour que ma boucle me mette chaque incrementation de 112 une par une ?

voici mon code:

Dim x As Integer
Dim y As Integer

For y = 2 To 23
For x = 114 To 2466 Step 112

Wbk1.Sheets("Feuil1").Cells(6, 2) = Wbk3.Sheets("Feuil1").Cells(x, 5).Value

Next y
Next x

Ma boucle remplace ce code là:

'Wbk1.Sheets("Feuil1").Range("B6") = Wbk3.Sheets("Feuil1").Range("E114").Value
' Wbk1.Sheets("Feuil1").Range("C6") = Wbk3.Sheets("Feuil1").Range("E226").Value
' Wbk1.Sheets("Feuil1").Range("D6") = Wbk3.Sheets("Feuil1").Range("E338").Value
' Wbk1.Sheets("Feuil1").Range("E6") = Wbk3.Sheets("Feuil1").Range("E450").Value
' Wbk1.Sheets("Feuil1").Range("F6") = Wbk3.Sheets("Feuil1").Range("E562").Value
' Wbk1.Sheets("Feuil1").Range("G6") = Wbk3.Sheets("Feuil1").Range("E674").Value
' Wbk1.Sheets("Feuil1").Range("H6") = Wbk3.Sheets("Feuil1").Range("E786").Value
' Wbk1.Sheets("Feuil1").Range("I6") = Wbk3.Sheets("Feuil1").Range("E898").Value
' Wbk1.Sheets("Feuil1").Range("J6") = Wbk3.Sheets("Feuil1").Range("E1010").Value
' Wbk1.Sheets("Feuil1").Range("K6") = Wbk3.Sheets("Feuil1").Range("E1122").Value
' Wbk1.Sheets("Feuil1").Range("L6") = Wbk3.Sheets("Feuil1").Range("E1234").Value
' Wbk1.Sheets("Feuil1").Range("M6") = Wbk3.Sheets("Feuil1").Range("E1346").Value
' Wbk1.Sheets("Feuil1").Range("N6") = Wbk3.Sheets("Feuil1").Range("E1458").Value
'Wbk1.Sheets("Feuil1").Range("O6") = Wbk3.Sheets("Feuil1").Range("E1570").Value
' Wbk1.Sheets("Feuil1").Range("P6") = Wbk3.Sheets("Feuil1").Range("E1682").Value
' Wbk1.Sheets("Feuil1").Range("Q6") = Wbk3.Sheets("Feuil1").Range("E1794").Value
' Wbk1.Sheets("Feuil1").Range("R6") = Wbk3.Sheets("Feuil1").Range("E1906").Value
' Wbk1.Sheets("Feuil1").Range("S6") = Wbk3.Sheets("Feuil1").Range("E2018").Value
' Wbk1.Sheets("Feuil1").Range("T6") = Wbk3.Sheets("Feuil1").Range("E2130").Value
' Wbk1.Sheets("Feuil1").Range("U6") = Wbk3.Sheets("Feuil1").Range("E2242").Value
' Wbk1.Sheets("Feuil1").Range("V6") = Wbk3.Sheets("Feuil1").Range("E2354").Value
' Wbk1.Sheets("Feuil1").Range("W6") = Wbk3.Sheets("Feuil1").Range("E2466").Value

End Sub

j'espère que vous avez compris ce que je voulais dire

merci d'avance de votre aide

Afficher la suite

A voir également:

Boucle for copie coller cellule
Downloader for pc - Télécharger - Téléchargement & Transfert
Copie ecran ipad - Guide
Copie disque dur - Guide
Symbole a copier coller - Guide
Historique copier coller - Guide

5 réponses

Réponse 1 / 5
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
bonjour,
```
Sub test()
    Dim x As Integer
    Dim y As Integer

'Wbk1.Sheets("Feuil1").Range("B6") = Wbk3.Sheets("Feuil1").Range("E114").Value
    ' Wbk1.Sheets("Feuil1").Range("C6") = Wbk3.Sheets("Feuil1").Range("E226").Value
    y = 2
    For x = 114 To 2466 Step 112
        Wbk1.Sheets("Feuil1").Cells(6, y) = Wbk3.Sheets("Feuil1").Cells(x, 5).Value
        y = y + 1
        If y > 23 Then Exit For
    Next x
End Sub
```
0
1. she
  
  Bonjour, merci pour votre réponse.
  
  par contre j'aurai une question qui peut paraitre bête mais j'aimerai savoir si il est possible de copier des données d'un fichier pdf pour les coller automatiquement dans un fichier excel en macro.
  Si cela n'est pas possible , j'aimerai savoir comment faire pour copier des données d'un fichier excel où les données inscrite ne sont pas fixe.
  J'avais dans l'idée de copier les données (qui sont des pourcentages) en les reliant à la ligne du texte qui leur correspond.
  Donc trouver et copier le chiffre en fonction des informations "texte" qui sont autour de lui et non par ces cellules.
  
  j'espère que vous avez compris ce que je voulais dire.
  merci d'avance pour votre aide
  
  0
2. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
  
  Bonjour,
  
  lire un fichier PDF:
  
  https://www.developpez.net/forums/d431662/logiciels/microsoft-office/general-vba/contribuez/excel-word-pdf-adobe-acrobat-pro-pdfcreator-1-7-3-obsolete/
  
  Si cela n'est pas possible , j'aimerai savoir comment faire pour copier des données d'un fichier excel où les données inscrite ne sont pas fixe. Un peu plus d'explications svp
  
  0
3. she
  
  en faite se sont des données tirées d'un logiciel qu'on peut convertir en excel ou pdf.
  mon travail est de reprendre des données précise de ce fichier excel ou PdF et les copié dans un autre classeur excel (par macro).
  Le probleme du fichier excel est que les données convertie ne reste pas fixe c'est à dire qu'il ne sont jamais dans la même cellule.
  
  0
4. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
  
  Re,
  
  Le probleme du fichier excel est que les données convertie ne reste pas fixe c'est à dire qu'il ne sont jamais dans la même cellule. Oui, mais y a t-il quelque chose qui puisse nous faire reconnaitre ces donnees, un texte ou autre. A defaut pouvez-vous mettre deux de ces fichier excel a dispo
  
  0
5. she
  
  Bonjour,
  
  les intitulées des colonnes ne change pas, comme se sont des fichiers professionnel j'ai changé le contenu du document mais la mise en forme reste pareil.
  je dois récupérer le pourcentage des lignes correspondant à" environnement" et" essai " du fichier "tableau de bord.xls" pour chaque fruit et les copier dans le fichier excel "tableau_final.xlsm". Au ligne A7:V7 et A8:V8
  La cellule W7 vient de la ligne " moyenne" du tableau de bord
  Tous cela si possible par macro
  
  Merci d'avance pour votre aide
  
  PS: comment ajouter les fichiers ?
  
  0

f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Re,

un exemple de code, au plus simple, a condition que les fichiers d'infos soit tous de la meme structure en colonnes et lignes

https://www.cjoint.com/c/DGdshg8JkH0

Si fichier infos pas tous du meme format, ca peut se faire avec modif

she

Bonjour f894009,

merci pour votre aide

j'aurai aimé savoir si il est possible de copier les données sans aller chercher le fichier source via la boite de dialogue.
De plus, pouvez vous m'expliqué à quoi correspond exactement "derlig" et "point"
dans le code.
merci
PS: comment fait-on pour changer le fichier source dans le code j'ai essayé, mais à chaque fois il ne se passe rien.
il faut bien changer le titre du fichier ici :
swbName = Application.GetOpenFilename(" Classeur Microsoft EXCEL (*.xls*), *.xls*",2, "Ouverture Fichier Tableau de bord", True)
0

f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Bonjour,

code avec plus de commentaires

Sub Recup_Infos()
    Dim swbName As Variant
    Dim wb As Workbook, sh As Worksheet
    
    Application.ScreenUpdating = False ' turn off the screen updating
    Ce_Classeur = ThisWorkbook.Name
    For Each sh In Worksheets
        If sh.Name = "A" Then
            Application.DisplayAlerts = False
            Worksheets("A").Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next
    'recherche fichier infos
    swbName = Application.GetOpenFilename(" Classeur Microsoft EXCEL (*.xls*), *.xls*", 2, "Ouverture Fichier Tableau de bord", True)
    'pas de fichier
    If swbName = False Then Exit Sub
    'ouverture fichier
    Set wb = Workbooks.Open(swbName, True)
    'copie onglet infos
    wb.Sheets("A").Copy After:=Workbooks(Ce_Classeur).Sheets(Sheets.Count)
    'fermeture fichier infos
    wb.Close False
    
    Rech1 = "ENVIRONNEMENT"
    Rech2 = "ESSAI"
    
    With Worksheets("A")
        'derniere cellule non vide colonne C
        derlig = .Range("C" & Rows.Count).End(xlUp).Row
        'Total
        Worksheets("feuil1").Range("W7") = .Range("C" & derlig)
        'mise en memoire des donnees colonne A
        Set TColB = .Range("A3:A" & derlig)
            'nombre de fois "ENVIRONNEMENT" dans la colonne B
            Nb = Application.CountIf(TColB, Rech1)
            If Nb > 0 Then      'trouve au moins une fois
                lig = 3
                'boucle de recherche a partir de lig trouvee (permet de ne pas faire toutes les lignes
                For Point = 1 To Nb
                    'recherche ligne pour "ENVIRONNEMENT"
                    lig = .Columns("A").Find(Rech1, .Cells(lig, "A"), , xlWhole).Row
                    'ecriture %
                    Worksheets("feuil1").Cells(7, 1 + Point) = .Cells(lig, 3)
                    'recherche ligne pour "ESSAI" en partant de la ligne "ENVIRONNEMENT"
                    lig = .Columns("A").Find(Rech2, .Cells(lig, "A"), , xlWhole).Row
                    'ecriture %
                    Worksheets("feuil1").Cells(8, 1 + Point) = .Cells(lig, 3)
                Next Point
            End If
    End With
    Application.ScreenUpdating = True
    Worksheets("feuil1").Activate
End Sub

j'aurai aimé savoir si il est possible de copier les données sans aller chercher le fichier source via la boite de dialogue
Si c'est toujours le meme nom au meme endroit pourquoi pas. Est-ce le cas ????

she

oui c'est le cas une fois le fichier enregistré il ne bouge plus
0

f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Re,

mis en commentaire boite dial

Sub Recup_Infos()
    Dim swbName As Variant
    Dim wb As Workbook, sh As Worksheet
    
    Application.ScreenUpdating = False ' turn off the screen updating
    Ce_Classeur = ThisWorkbook.Name
    For Each sh In Worksheets
        If sh.Name = "A" Then
            Application.DisplayAlerts = False
            Worksheets("A").Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next
    'recherche fichier infos
    'swbName = Application.GetOpenFilename(" Classeur Microsoft EXCEL (*.xls*), *.xls*", 2, "Ouverture Fichier Tableau de bord", True)
    'pas de fichier
    'If swbName = False Then Exit Sub
    'ouverture fichier: mettre le chemin complet et le le nom du fichier avec extention (.xls)
    ' ici pour exemple
    swbName = "C:\mondossier\monfichier.xls"
    Set wb = Workbooks.Open(swbName, True)
    'copie onglet infos
    wb.Sheets("A").Copy After:=Workbooks(Ce_Classeur).Sheets(Sheets.Count)
    'fermeture fichier infos
    wb.Close False
    
    Rech1 = "ENVIRONNEMENT"
    Rech2 = "ESSAI"
    
    With Worksheets("A")
        'derniere cellule non vide colonne C
        derlig = .Range("C" & Rows.Count).End(xlUp).Row
        'Total
        Worksheets("feuil1").Range("W7") = .Range("C" & derlig)
        'mise en memoire des donnees colonne A
        Set TColB = .Range("A3:A" & derlig)
            'nombre de fois "ENVIRONNEMENT" dans la colonne B
            Nb = Application.CountIf(TColB, Rech1)
            If Nb > 0 Then      'trouve au moins une fois
                lig = 3
                'boucle de recherche a partir de lig trouvee
                For Point = 1 To Nb
                    'recherche ligne pour "ENVIRONNEMENT"
                    lig = .Columns("A").Find(Rech1, .Cells(lig, "A"), , xlWhole).Row
                    'ecriture %
                    Worksheets("feuil1").Cells(7, 1 + Point) = .Cells(lig, 3)
                    'recherche ligne pour "ESSAI" en partant de la ligne "ENVIRONNEMENT"
                    lig = .Columns("A").Find(Rech2, .Cells(lig, "A"), , xlWhole).Row
                    'ecriture %
                    Worksheets("feuil1").Cells(8, 1 + Point) = .Cells(lig, 3)
                Next Point
            End If
    End With
    Application.ScreenUpdating = True
    Worksheets("feuil1").Activate
End Sub

she

bonjour,

les donnée copier s'ajoute de deux zero, à la place par exemple de 45% j'ai 4500%
j'ai essayé de résoudre le probleme mais je n'ai pas réussi. De plus,
J'ai oublié de vous demander si il était possible de copier toute ses données sans copier l'onglet du fichier info dans le classeur cible

merci pour votre aide et vos explications
0

Réponse 3 / 5
Iama Messages postés 324 Statut Membre 14

Bonjour She

En regardant rapidement ton code. Je remarque deux choses.

1) Tes boucles y et x sont enchevêtrées
2) y n'intervient pas dans ta formule de copie.

Je pense qu'il est donc normal que tu aie des problèmes

Iama
0
Réponse 4 / 5
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Bonjour Iama,

Si vous ecrivez a propos du code de depart, j'ai donne un exemple de code qui resolvais ce probleme et il n'est plus d'actualite pas parce qu'il est resolu mais parce que le contexte a change a partir du 02 juil (voir les messages ci-dessus)
0
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Réponse 5 / 5
Iama Messages postés 324 Statut Membre 14

Merci f894009,

de ces précisions, je vais regarder ton code.

Mes remarque, sont-elles erronées?
Iama
0
1. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
  
  Re,
  
  Mes remarque, sont-elles erronées? Non, c'etait le soucis du moment
  
  0

Boucle for copie coller cellule

5 réponses

Discussions similaires

Newsletters