Fusion de plusieurs fichiers Excel
Bonjour à tous,
J'ai déjà vu des sujets à ce sujet mais aucune macro ne semble fonctionner ou en tout cas ne fonctionne pas pour mon cas qui me semblait simple.
Je possède 90 fichiers (xlsx) qui ont parfois plusieurs feuilles.
J'aimerais tous les combiner dans un seul fichier excel nouveau.
Par ailleurs, j'aimerais une autre macro pour regrouper sur une meme feuille toutes les données Excel d'un classeur à plusieurs feuilles.
Quelqu'un aurait il ces deux macro magique ?
Merci par avance,
Bonjour,
Teste ceci concernant ta seconde question :
Sub Regrouper()
Dim FeRecap As Worksheet
Dim Fe As Worksheet
Dim LaPlage As Range
Dim Lg As Long
'la feuille qui récupére les valeurs se nomme "Recap", à adapter...
Set FeRecap = Worksheets("Recap")
'parcour de la collection :
For Each Fe In Worksheets
'évite de prendre en compte la feuille Recap
If Fe.Name <> FeRecap.Name Then
'défini la plage à récupérer
Set LaPlage = Plage(Fe)
'si existe...
If Not LaPlage Is Nothing Then
'recherche la dernière ligne non vide de la feuille Recap puis décale vers le bas, si la feuille est vierge, lg=1
If Not Plage(FeRecap) Is Nothing Then Lg = Plage(FeRecap).Rows.Count + 1 Else Lg = 1
'inscription des valeurs
With FeRecap
.Range(.Cells(Lg, 1), .Cells(LaPlage.Rows.Count + Lg - 1, LaPlage.Columns.Count)).Value = LaPlage.Value
End With
End If
End If
Next Fe
End Sub
Function Plage(Fe As Worksheet) As Range
On Error GoTo Fin
With Fe
Set Plage = .Range(.Cells(1, 1), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
Exit Function
Fin:
Set Plage = Nothing
End Function
Je regarde pour la première !
Re,
Pour la récup des classeurs :
Sub Consolider()
Dim Cls As Workbook
Dim Fe As Worksheet
Dim Tablo() As String
Dim Chemin As String
Dim I As Integer
Chemin = "C:\Mon Dossier\"
'appel de la fonction avec le chemin du dossier (adapter...)
Tablo = RecupFichiers(Chemin)
'si au moins un fichier trouvé...
If Not (Not Tablo) Then
For I = 1 To UBound(Tablo)
'ouvre le classeur...
Set Cls = Workbooks.Open(Chemin & Tablo(I))
'parcours sa collection de feuilles...
For Each Fe In Cls.Worksheets
'c'est ici qu'il te faut savoir quoi faire ?..
'pour le test, inscrit le nom des feuilles dans la fenêtre d'exécution (Ctrl+G)
Debug.Print Fe.Name
Next Fe
'referme le classeur
Cls.Close False
Next I
End If
End Sub
Function RecupFichiers(Chemin As String) As String()
Dim Tbl() As String
Dim Fichier As String
Dim I As Integer
'seulement les fichiers .xlsx
Fichier = Dir(Chemin & "*.xlsx")
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Fichier
Fichier = Dir()
Loop
RecupFichiers = Tbl()
End Function
il te faut savoir quoi faire, les feuilles doivent être ajoutées au nouveau classeur ? Une seule feuille qui regroupe les valeurs des autres feuilles du même classeur ?