Reunir plusieurs onglets de fichier differents

[Manu62]

Bonjour,

J'ai plusieurs fichiers excel avec pour tous 1 seul onglet de compléter.
les tableaux sont tous les mêmes sauf le nom de l'onglet.

Est t'il possible dans un fichier principal de réunir tous les onglets des classeurs.

Les fichiers sont stockés dans 1 même et seul répertoire.

Merci de vos lumières

Manu

 

[camarchepas]

Re : Reunir plusieurs onglets de fichier differents

Bonjour ,

Petite coquille dans mon code , comme cela , ça devrait alller mieux

Sub Copie()
Dim Classeur As String
Dim Chemin As String
Dim Onglet As Worksheet
Dim LigneFin As Long, LigneFinACopier As Long
'Exemple : Chemin à adapter
Chemin = "Z:\Emmanuel\Inventaire\31 08 2014\xls\"
'Si uniquement des fichhiers xsl ou xslx , modifier l'extension en conséquence
Classeur = Dir(Chemin & "*.xlsx") ' ici le * aprés le xlsx n'est donc plus nécessaire , j'ai enlevé
Do
If Classeur <> "" Then
Application.EnableEvents = False
Workbooks.Open Chemin & Classeur
For Each Onglet In Workbooks(Classeur).Worksheets
'Trouve une cellule qui est systématiquement renseigné pour l'exemple ici C13 à modifier
     If Onglet.Range("C13") <> "" Then
     
      'Ajout de la création de l'onglet
      ThisWorkbook.Worksheets.Add
      ThisWorkbook.ActiveSheet.Name = Onglet.Name
      LigneFinACopier = Onglet.Range("A" & Rows.Count).End(xlUp).Row
       Onglet.Range("A1:H" & LigneFinACopier).Copy Destination:=ThisWorkbook.Sheets("Feuil1").Range("A1")
     Exit For
     End If
Next
Workbooks(Classeur).Close False
Application.EnableEvents = True
End If
Classeur = Dir
Loop Until Classeur = ""
End Sub

 

[Manu62]

Re : Reunir plusieurs onglets de fichier differents

Bjr,

Le données ne sont pas dans les feuilles de chaque onglets. a chaque fois qu'il créer un onglet, j'ai l'impression que le code supprime les données de l'onglet précédent...

Manu

 

[camarchepas]

Re : Reunir plusieurs onglets de fichier differents

Bonjour ,

Et comme cela

Sub Copie()
Dim Classeur As String
Dim Chemin As String
Dim Onglet As Worksheet
Dim LigneFin As Long, LigneFinACopier As Long
'Exemple : Chemin à adapter
Chemin = "Z:\Emmanuel\Inventaire\31 08 2014\xls\"
'Si uniquement des fichhiers xsl ou xslx , modifier l'extension en conséquence
Classeur = Dir(Chemin & "*.xlsx") ' ici le * aprés le xlsx n'est donc plus nécessaire , j'ai enlevé
Do
If Classeur <> "" Then
Application.EnableEvents = False
Workbooks.Open Chemin & Classeur
For Each Onglet In Workbooks(Classeur).Worksheets
'Trouve une cellule qui est systématiquement renseigné pour l'exemple ici C13 à modifier
     If Onglet.Range("C13") <> "" Then
     
      'Ajout de la création de l'onglet
      ThisWorkbook.Worksheets.Add
      ThisWorkbook.ActiveSheet.Name = Onglet.Name
      LigneFinACopier = Onglet.Range("A" & Rows.Count).End(xlUp).Row
       Onglet.Range("A1:H" & LigneFinACopier).Copy Destination:=ThisWorkbook.Sheets(Onglet.Name).Range("A1")
     Exit For
     End If
Next
Workbooks(Classeur).Close False
Application.EnableEvents = True
End If
Classeur = Dir
Loop Until Classeur = ""
End Sub