Regrouper 3 fichiers excel de même structure en un seul fichier

[zizoufan]

Bonjour à tous,

je voudrais regrouper 2 fichiers excel en un seul. j'ai essayé avec ce code :

Sub Compilation()
Dim Temp As String
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Recap.xls" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Recap.xls").Sheets(1).Activate
If Cells(1, 1) = "" Then col = 1 Else col = Cells(1, 1).End(xlToRight).Column + 1
Cells(1, col).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

Sauf que cela me donne pas le résultat escompté. Mon souhait c'est de copier le contenu des fichiers sans les entêtes vers le fichier recap en gardant la même structure.

Merci de votre aide précieuse.

 

[Dranreb]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

Bonjour.
Essayez comme ça:

Sub Compilation()
Dim Temp As String, Cel As Range
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Temp = Dir("*.xls*")
Application.DisplayAlerts = False
Do While Temp <> ""
  If Temp <> ThisWorkbook.Name Then
    Set Cel = Feuil1.Cells(1, 1)
    If Cel.Value = "" Then Set Cel = Cel.End(xlToRight).Offset(, 1)
    Workbooks.Open Temp
    ActiveWorkbook.Worksheets(1).Range("A1").CurrentRegion.Copy Destination:=Cel
    ActiveWorkbook.Close
  End If
  Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

À tester.
À +

 

[zizoufan]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

Bonjour.
Essayez comme ça:

Sub Compilation()
Dim Temp As String, Cel As Range
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Temp = Dir("*.xls*")
Application.DisplayAlerts = False
Do While Temp <> ""
  If Temp <> ThisWorkbook.Name Then
    Set Cel = Feuil1.Cells(1, 1)
  If Cel.Value = "" Then Set Cel = Cel.End(xlToRight).Offset(, 1)
    Workbooks.Open Temp
    ActiveWorkbook.Worksheets(1).Range("A1").CurrentRegion.Copy Destination:=Cel
    ActiveWorkbook.Close
  End If
  Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

À tester.
À +

il y a une erreur sur la ligne :

If Cel.Value = "" Then Set Cel = Cel.End(xlToRight).Offset(, 1)

je pense qu'il y a un élément qui manque ? Non

 

[Dranreb]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

À priori non.
Je n'ai pas testé mais j'ai quand même compilé le projet: pas d'erreur.
Mettez un espion sur Cel.Address. C'est sûr que si les colonnes sont pleines ça va coincer.

P.S. J'ai triché pour l'exécuter jusque là sans ouvrir de fichier .xlsx que je ne sais pas ouvrir,
J'ai eu Cel.Address "$A$1". J'ai aloer mis un autre espion:
Cel.End(xlToRight).Address = $IV$1
Ah ca yest, Erreur de ma part: il faut:
If Cel.Value <> "" Then Set Cel = Cel.End(xlToRight).Offset(, 1)
À +

 

[zizoufan]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

À priori non.
Je n'ai pas testé mais j'ai quand même compilé le projet: pas d'erreur.
Mettez un espion sur Cel.Address. C'est sûr que si les colonnes sont pleines ça va coincer.
À +

Bonjour Dranreb,

Merci d'avoir prendre la peine de me répondre. En fait, quand j’exécute le projet il me donne l'erreur suivante
Erreur d'exécution 1004 Erreur définie par l'application ou par l'objet.
Pourrais-tu faire un test sur les fichiers que je t'ai envoyés ? Merci

 

[Dranreb]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

Voir P.S poste précédent.

 

[zizoufan]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

toujours la même erreur mais cette fois sur la ligne suivante :

Cells(1, col).Select

 

[Dranreb]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

Il n'y a aucune utilisation de variable "col" dans mon code.

 

[zizoufan]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

excuses moi voila le résultat que cela donne (voir fichier joint). Et c'est exactement ce que j'avais avant

 

[Dranreb]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

C'est vous qui aviez initialement mis des xlToRight pour empiler dans des colonnes successives, ce qui me semblait bizarre, alors j'ai suivi.

If Cel.Value <> "" Then Set Cel = Cel.End(xlDown).Offset(1)

 

[zizoufan]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

C'est vous qui aviez initialement mis des xlToRight pour empiler dans des colonnes successives, ce qui me semblait bizarre, alors j'ai suivi.

If Cel.Value <> "" Then Set Cel = Cel.End(xlDown).Offset(1)

On y est presque je pense. comment pourrais-je maintenant ne pas prendre les entêtes ?

Merci encore de ton aide précieuse.

 

[Dranreb]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

On pourrait compliquer pour ne copier que ce qu'il faut mais je crois qu'il vaudrait mieux avant le End If:

If Cel.Row > 1 Then Cel.EntireRow.Delete

 

[zizoufan]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

On pourrait compliquer pour ne copier que ce qu'il faut mais je crois qu'il vaudrait mieux avant le End If:

If Cel.Row > 1 Then Cel.EntireRow.Delete

Bonjour Dranreb,

ça marche, maintenant il ne me copie que les lignes sans entête. Cependant, à chaque fois que je lance le script il copie en double. Peut-on vider le fichier "récap" avant de le remplir à chaque fois que j’exécute la macro ?

Merci

 

[Dranreb]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

Bonjour.

Feuil1.Cells.EntireRow.Delete

au début.
Avec tout ce que vous avez déjà comme exemples d'instructions, n'auriez vous vraiment pas pu trouver ça tout seul ?
Cordialement.

 

[zizoufan]

Re : Regrouper 3 fichiers excel de même structure en un seul fichier

Bonjour.

Feuil1.Cells.EntireRow.Delete

au début.
Avec tout ce que vous avez déjà comme exemples d'instructions, n'auriez vous vraiment pas pu trouver ça tout seul ?
Cordialement.

Ça marche nickel. J'ai appris beaucoup grâce à ce petit projet encore merci