Réunir plusieurs fichiers EXCEL dans 1 seul
Résolu
ttjeremy
-
medmirgoul -
medmirgoul -
Bonjour,
j'ai un soucis Sur Excel.
Voila, j'ai Soixante fichiers excel de forme identique avec 5 à 6 onglets toujours de forme identique. (Ne demandez pas pourquoi c'est pour le TAF)
Ces fichiers ne se trouvent pas forcément dans le même dossier et ne sont pas en nombre identiques
Exemple:
DossierA : Dossier1,dossier2,dossier3,dossier4.....
Dossier1 : Exel1
Dossier2 : Excel2,Excel3
Dossier3 : Excel4,Excel5,Excel6
Dossier4 : Excel7,Excel8
Connaissez-vous une macro capable de tout me copier dans un Seul fichier Excel (Tout les fichiers les uns en dessous des autres) en indiquant le fichier dont l'info provient ainsi que l'onglet d'origine)
That is your challenge !!! Good Luck
PS : Je suis débutant en Macro, essayez d'expliquer simplement ou de me donner la macro entière.
j'ai un soucis Sur Excel.
Voila, j'ai Soixante fichiers excel de forme identique avec 5 à 6 onglets toujours de forme identique. (Ne demandez pas pourquoi c'est pour le TAF)
Ces fichiers ne se trouvent pas forcément dans le même dossier et ne sont pas en nombre identiques
Exemple:
DossierA : Dossier1,dossier2,dossier3,dossier4.....
Dossier1 : Exel1
Dossier2 : Excel2,Excel3
Dossier3 : Excel4,Excel5,Excel6
Dossier4 : Excel7,Excel8
Connaissez-vous une macro capable de tout me copier dans un Seul fichier Excel (Tout les fichiers les uns en dessous des autres) en indiquant le fichier dont l'info provient ainsi que l'onglet d'origine)
That is your challenge !!! Good Luck
PS : Je suis débutant en Macro, essayez d'expliquer simplement ou de me donner la macro entière.
A voir également:
- Copier plusieurs fichiers excel dans un seul
- Liste déroulante excel - Guide
- Formule moyenne excel plusieurs colonnes - Guide
- Comment réduire la taille d'un fichier - Guide
- Renommer plusieurs fichiers en même temps - Guide
- Comment ouvrir un fichier epub ? - Guide
22 réponses
Compiler des fichiers ferméS dans un même répertoire:
Sub compil()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Dim rsdata As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim videderniereligne As String
Dim derniereligne As String
Dim U As Object
Dim feuille As String
Dim i As Integer
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Direction = Dir(ThisWorkbook.Path & "\*.xls")
'Direction = Dir(cheminarchivelocal & "*.xls")
Cells.Select
Range("P1").Activate
Selection.ClearContents
Selection.Delete Shift:=xlUp
Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop
If nbFichiers > 0 Then
For X = 1 To nbFichiers
'derniereligne = Worksheets("Feuil1").Range("A5").Rows.Count
If Tableau(X) <> ThisWorkbook.Name Then
'[reportdetailleAZF20070831.xls]Feuil1!$A$2
feuille$ = "zer3_PHA (4)"
'repertoire = "D:\Archivefacturedetc\reportdetaille"
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\" & Tableau(X) & ";" & _
"Extended Properties=""Excel 8.0;HDR=yes; IMEX=1"";"
'"Data Source=" & ThisWorkbook.Path & "\" & Tableau(X) & ";" & _
szSQL = "SELECT * FROM [" & feuille & "$]"
Set rsdata = New ADODB.Recordset
rsdata.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
''' Vérifie qu'on a bien reçu des données
If Not rsdata.EOF Then
Sheets("Feuil1").Select
If Range("A1").Value = "" Then
Sheets("Feuil1").Range("A1").CopyFromRecordset rsdata
Else:
derniereligne = Worksheets("Feuil1").Range("A3").End(xlDown).Row
videderniereligne = derniereligne + 1
Sheets("Feuil1").Range("A" & videderniereligne).CopyFromRecordset rsdata
End If
End If
End If
Next
Sub compil()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Dim rsdata As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim videderniereligne As String
Dim derniereligne As String
Dim U As Object
Dim feuille As String
Dim i As Integer
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Direction = Dir(ThisWorkbook.Path & "\*.xls")
'Direction = Dir(cheminarchivelocal & "*.xls")
Cells.Select
Range("P1").Activate
Selection.ClearContents
Selection.Delete Shift:=xlUp
Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop
If nbFichiers > 0 Then
For X = 1 To nbFichiers
'derniereligne = Worksheets("Feuil1").Range("A5").Rows.Count
If Tableau(X) <> ThisWorkbook.Name Then
'[reportdetailleAZF20070831.xls]Feuil1!$A$2
feuille$ = "zer3_PHA (4)"
'repertoire = "D:\Archivefacturedetc\reportdetaille"
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\" & Tableau(X) & ";" & _
"Extended Properties=""Excel 8.0;HDR=yes; IMEX=1"";"
'"Data Source=" & ThisWorkbook.Path & "\" & Tableau(X) & ";" & _
szSQL = "SELECT * FROM [" & feuille & "$]"
Set rsdata = New ADODB.Recordset
rsdata.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
''' Vérifie qu'on a bien reçu des données
If Not rsdata.EOF Then
Sheets("Feuil1").Select
If Range("A1").Value = "" Then
Sheets("Feuil1").Range("A1").CopyFromRecordset rsdata
Else:
derniereligne = Worksheets("Feuil1").Range("A3").End(xlDown).Row
videderniereligne = derniereligne + 1
Sheets("Feuil1").Range("A" & videderniereligne).CopyFromRecordset rsdata
End If
End If
End If
Next