Boucle for copie coller cellule

Fermé
she - 1 juil. 2014 à 16:11
 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


A voir également:

5 réponses

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
1 juil. 2014 à 17:35
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
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
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
2 juil. 2014 à 11:57
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
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
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 2/07/2014 à 17:01
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
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 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
3 juil. 2014 à 18:09
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
0
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 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 juil. 2014 à 13:54
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 ????
0
oui c'est le cas une fois le fichier enregistré il ne bouge plus
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 juil. 2014 à 14:24
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
0
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
Iama Messages postés 319 Date d'inscription mercredi 13 janvier 2010 Statut Membre Dernière intervention 27 mars 2020 14
3 juil. 2014 à 20:26
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
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 juil. 2014 à 07:06
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
Iama Messages postés 319 Date d'inscription mercredi 13 janvier 2010 Statut Membre Dernière intervention 27 mars 2020 14
4 juil. 2014 à 09:34
Merci f894009,

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

Mes remarque, sont-elles erronées?
Iama
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 juil. 2014 à 11:57
Re,

Mes remarque, sont-elles erronées? Non, c'etait le soucis du moment
0