Boucle for copie coller cellule

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

5 réponses

  1. Merci f894009,

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

    Mes remarque, sont-elles erronées?
    Iama
    1. Re,

      Mes remarque, sont-elles erronées? Non, c'etait le soucis du moment
  2. 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)
    1. 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
      1. 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
        1. 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)
        2. 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 ????
        3. oui c'est le cas une fois le fichier enregistré il ne bouge plus
        4. 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
        5. 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
      2. 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
        1. 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
        2. 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.
        3. 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
        4. 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 ?