Boucle pour copier/coller des cellules de plusieurs classeurs.

[Pat2A]

Bonjour messieurs,

J'arrive au terme de mon projet Excel et je vous remercie pour toutes les informations trouvées ici qui m'ont permis d'avancer.

Reste plus qu'une dernière étape: L'importation des données.

J'utilise le classeur d'origine ("Classeur1") qui comprends 150 feuilles.
Les classeurs 2, 3 et 4 sont utilisés par des organismes différents et sont une copie du classeur 1.
Les feuilles 1 à 50 sont remplies sur le "Classeur2", 51 à 100 sur le "Classeur3" et 101 à 150 sur le "Classeur4".
Les noms de feuille des 4 classeurs sont donc identiques.

Est-il possible de faire une boucle pour copier ces 150 plages de cellules sur mon "Classeur1" afin d'éviter de copier 150 fois mon code ci-dessous? (avec possibilité d'importer un classeur à la fois)

NB: Le bouton de commande de la macro est sur le classeur d'origine (Classeur1)

Private Sub CommandButton1_Click()
  Worksheets("Feuil1").Cells.ClearContents
     Workbooks.Open Filename:="D:\Test Import\Classeur2.xls"
         With Workbooks("Classeur2.xls").Worksheets("Feuil1")
             derlign = .Range("A2").End(xlDown).Row
             .Range(.Cells(2, 1), .Cells(derlign, 9)).Copy _
             Workbooks("Classeur1.xls").Worksheets("Feuil1").Range("A2")
         End With
  Workbooks("Classeur2.xls").Close False
End Sub

Merci de votre attention

 

[Pat2A]

Re : Boucle pour copier/coller des cellules de plusieurs classeurs.

Pas d'amateur pour m'éclairer?
J'ai essayé d'adapter des boucles trouvées sur le forum mais sans succès.
Avec mon petit niveau en Vba Excel j'ai du mal à m'en sortir tout seul.
Pouvez-vous m'aider s'il vous plaît?

 

[Pierrot93]

Re : Boucle pour copier/coller des cellules de plusieurs classeurs.

Bonjour,

regarde peut être ceci, mais comme pas de fichier pour tester, je te laisse adapter le cas echéant :

Option Explicit
Sub test()
Dim k As Byte, i As Byte, wb As Workbook, j As Byte
ThisWorkbook.Worksheets("Feuil1").Cells.ClearContents
k = 1
For i = 1 To 3
    Set wb = Workbooks.Open(Filename:="D:\Test Import\Classeur" & i + 1 & ".xls")
        For j = k To 50 * i
            With wb.Worksheets("Feuil" & i)
                    .Range("A2:I" & .Range("A65536").End(xlUp).Row).Copy _
                    ThisWorkbook.Worksheets("Feuil1").Range("A65536").End(xlUp)(2)
            End With
        Next j
        k = k + 50
    wb.Close
Next i
End Sub

bonne journée
@+

Edition : modification code gestion des feuilles

 

[Pat2A]

Re : Boucle pour copier/coller des cellules de plusieurs classeurs.

Bonjour Pierrot93,

Merci pour ta réponse cela m'a permis d'avancer en corrigeant légèrement ton code pour que cela fonctionne correctement tu avais omis la boucle sur les feuilles destinataires:

 Private Sub CommandButton1_Click()
     Dim k As Byte, i As Byte, j As Byte, wb As Workbook
     ThisWorkbook.Worksheets("Feuil1").Cells.ClearContents
    k = 1
     For i = 1 To 3
         Set wb = Workbooks.Open(Filename:="D:\Test Import\Classeur" & i + 1 & ".xls")
             For j = k To 50 * i
                 With wb.Worksheets("Feuil" & j)
                     .Range("A2:I" & .Range("A65536").End(xlUp).Row).Copy _
                     ThisWorkbook.Worksheets("Feuil" & j).Range("A65536").End(xlUp)(2)
                 End With
             Next j
         k = k + 50
         wb.Close
     Next i
 End Sub

Donc tout fonctionne dans mes classeurs test.
La difficulté supplémentaire c'est que mes classeurs originaux et leurs feuilles ont des noms différents de "Classeur1" et "Feuil1"...

Serait-il possible de faire référence dans le "Visual Basic Editor" aux numéros de feuille de la liste "Microsoft Excel Objets"?
On voit en effet dans cette liste que les feuilles gardent leur numérotation d'origine même après les avoir renommées.

Sinon je pense qu'en créant une liste des noms des 150 feuilles dans une feuille Excel, on pourrait s'en sortir.

Qu'en pensez-vous?

 

[Pierrot93]

Re : Boucle pour copier/coller des cellules de plusieurs classeurs.

Re,

La difficulté supplémentaire c'est que mes classeurs originaux et leurs feuilles ont des noms différents de "Classeur1" et "Feuil1"...

bah ca.... ma boule de cristal ne me la pas dit..... pour les feuilles peut être utiliser les numéros d'index (worksheets(i)), pour les classeurs un "array".....

 

[Pat2A]

Re : Boucle pour copier/coller des cellules de plusieurs classeurs.

Merci beaucoup Pierrot93, cela fonctionne parfaitement!
J'ai juste mis le ClearContents dans la boucle pour effacer toutes mes feuilles destinataires avant la copie.

Pour ceux que cela intéresse:

 Private Sub CommandButton1_Click()
     Dim k As Byte, i As Byte, j As Byte, wb As Workbook     
     k = 1
     For i = 1 To 3
         Set wb = Workbooks.Open(Filename:="D:\Test Import\Classeur" & i + 1 & ".xls")
             For j = k To 50 * i
                 ThisWorkbook.Worksheets(j).Cells.ClearContents
                 With wb.Worksheets(j)
                     .Range("A2:I" & .Range("A65536").End(xlUp).Row).Copy _
                     ThisWorkbook.Worksheets(j).Range("A65536").End(xlUp)(2)
                 End With
             Next j
         k = k + 50
         wb.Close
     Next i
 End Sub

Merci encore.

Bonne journée.

 

[Pierrot93]

Re : (Résolu) Boucle pour copier/coller des cellules de plusieurs classeurs.

Re,

pas vu non plus qu'il y avait plusieurs feuilles destinataires...............

@+

 

[Pat2A]

Re : (Résolu) Boucle pour copier/coller des cellules de plusieurs classeurs.

Bonjour messieurs du forum.
Suite au changement d'ordinateur au boulot, passage à Windows 7 au lieu de XP, ce programme ne fonctionne plus.
Le message d'erreur "Excel ne peut pas terminer cette tâche avec les ressources disponibles. Sélectionnez moins de données ou fermez des applications." s'affiche constamment.
Pour que cela fonctionne je suis obliger de copier les pages en plusieur étapes et d'enregistrer le classeur entre chaque étape.
Le plus étrange c'est que le message d'erreur s'affiche même si toutes les feuilles copiées sont vides.
De plus ce système de copie est très long même si toutes les feuilles sont vides.
Existe-t-il une méthode me permettant d'utiliser moins de mémoire afin d'éviter ce message d'erreur?
Je suis toujours en Excel 2003 et le nouvel ordinateur dispose de 3Go de mémoire alors que je ne disposait que d'1Go sur l'ancien...
CODE:
Sub Macro40 ()
Application.ScreenUpdating =False
Dim i As Byte, Wb As Workbook
Set Wb = Workbooks.Open (Filename:="D:\TEST\Import .xls")
For i = 4 to 49
ThisWorkbook.WorkSheets(i).Range("A2:I" & Range("A2").End(xlDown).Row).ClearContents
With Wb.WorkSheets(i)
.Range("A2:I" & .Range("A2").End(xlDown).Row).Copy _
ThisWorkbook.WorkSheets(i).Range("A2")
End With
Next i
Wb.Close SaveChanges:=False
Unload UsFImport
Application.ScreenUpdating = True
End Sub

Merci de votre attention.
Bonne journée

 

[Pat2A]

Re : Boucle pour copier/coller des cellules de plusieurs classeurs.

Rebonjour,
Après plusieurs recherches, je m'aperçois en faisant du pas à pas que le code: "Range("A2").End(xlDown).Row" a toujours pour valeur 65536 quelque soit le nombre de case remplie dans la collone "A".
Je n'arrive pas à savoir pourquoi mais c'est surement la cause du code erreur ci-dessus.
Si quelqu'un à une idée ?
Merci

 

[flyonets44]

Re : Boucle pour copier/coller des cellules de plusieurs classeurs.

Bonsoir
tu peux remplacer Range("A2").End(xlDown).
par Range("a65536].End(xlUp).Row)
Cordialement
FLYONETS