Macro Excel pr concatener plusieurs fichiers

personne pour m'aider un peu ?

D'après mes recherches j'ai réussi à faire ouvrir des fichiers en parcourant une arborescence mais je n'arrive pas à charger les données sur une seule feuille. C'est pas si simple pour moi.

Je suis sure que s'est possible. Mais la sa fait déjà tout une après midi de perdu à chercher pour rien...

Merci à ceux qui oseront m'aider un peu.

Je vous joint ci-après 2 codes que j'ai trouvé sur Internet. Ils font presque ce que je veux mais pas tout à fait.
A tout ceux qui veulent m'aider, il ne s'agit plus de se prendre la tête à coder, mais à modifier légèrement un code existant. Donc encore plus facile et rapide.

Premier code :

Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean

Option Explicit

Dim TabFichiers() As String
Dim Dep As Currency, Fin As Currency, Freq As Currency
Dim n As Long, bFlagNomFeuille As Boolean
Dim iRow As Long, Cpt As Long, NbFichiers As Long, sNum As String, sNomAct As String

Const sNomFeuilleALire As String = "Material"
Const iRowDep As Long = 3
Const sNomFeuillesDatas As String = "Material"
Const TypeFichier As String = "xls"

Private Sub DispoBoutons()
Dim t As Range
With ShMaterial
.Activate
.Rows(1).RowHeight = 30.75

Set t = .Cells(1, 1)
With .Buttons("Bouton 1")
.Left = t.Left + 3
.Top = t.Top + 5
.Width = 100
.Height = Rows(1).RowHeight - 8
End With

With .Buttons("Bouton 2")
.Left = ShMaterial.Buttons("Bouton 1").Left + ShMaterial.Buttons("Bouton 1").Width + 5
.Top = ShMaterial.Buttons("Bouton 1").Top
.Width = 100
.Height = ShMaterial.Buttons("Bouton 1").Height
End With
End With
End Sub

Private Sub Entete()
Dim i As Long
Range("A" & iRowDep - 1 & ":Y" & iRowDep - 1).Select

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

Selection.AutoFilter

Range("A" & iRowDep - 1).Interior.ColorIndex = 44
Range("F" & iRowDep - 1).Interior.ColorIndex = 44

For i = 1 To 25
ShMaterial.Cells(iRowDep - 1, i) = NumCol2Lettre(i)
Next i
End Sub

Private Function ExistenceNomFeuille(sNomFichier As String, sNomFeuille As String) As Boolean
Dim Conn As Object
Dim Cat As Object
Dim Feuille As Object
Dim sNom As String

Set Conn = CreateObject("ADODB.Connection")
Set Cat = CreateObject("ADOX.Catalog")

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sNomFichier & ";" & _
"Extended Properties=""Excel 8.0;"""

Set Cat.ActiveConnection = Conn

ExistenceNomFeuille = False
For Each Feuille In Cat.Tables
Select Case Right$(Feuille.Name, 1)
Case "$"
sNom = Left$(Feuille.Name, Len(Feuille.Name) - 1)
If sNom = sNomFeuille Then
ExistenceNomFeuille = True
Exit For
End If
Case "'"
sNom = Mid$(Feuille.Name, 2, Len(Feuille.Name) - 3)
If sNom = sNomFeuille Then
ExistenceNomFeuille = True
Exit For
End If
End Select
Next Feuille

Conn.Close
Set Cat = Nothing
Set Conn = Nothing
End Function

Private Sub Init()
iRow = iRowDep: Cpt = 0: NbFichiers = 0: n = 0: sNum = ""
ShMaterial.Cells.Clear
End Sub

Private Sub LectureFichiers()
Dim i As Long
For i = 1 To UBound(TabFichiers)
Lire TabFichiers(i)
Cpt = Cpt + 1
Next i
End Sub

Private Sub TestExistenceFeuilleDossier()
Dim i As Long, sNomFichier As String
Dim iMax As Long

iMax = UBound(TabFichiers)
bFlagNomFeuille = True

For i = LBound(TabFichiers) To UBound(TabFichiers)
bFlagNomFeuille = ExistenceNomFeuille(TabFichiers(i), sNomFeuilleALire)
If bFlagNomFeuille = False Then
Application.ScreenUpdating = True
sNomFichier = TabFichiers(i)
MsgBox sNomFeuilleALire & " n'existe pas dans " & vbCrLf & sNomFichier, vbOKOnly + vbCritical
Exit Sub
End If
Application.StatusBar = "Vérification existence : " & sNomFeuilleALire & " " & i & " / " & iMax
Next i
End Sub

Private Sub TestExistenceFeuille(ByVal sFichier As String)
Dim i As Long

bFlagNomFeuille = ExistenceNomFeuille(sFichier, sNomFeuilleALire)

If bFlagNomFeuille = False Then
Application.ScreenUpdating = True
MsgBox sNomFeuilleALire & " n'existe pas dans " & vbCrLf & sFichier, vbOKOnly + vbCritical
Exit Sub
End If
Application.StatusBar = "Vérification existence : " & sNomFeuilleALire & " " & Cpt & " / " & NbFichiers
End Sub

Private Sub Lire(ByVal sNomFichier As String)
Dim FSO As Object
Dim Fichier As String
Dim LastRow As Long
Dim Wkb As Workbook, sNomSh As String
Dim LastRowPaste As Long, i As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Fichier = FSO.GetFileName(sNomFichier)

Application.DisplayAlerts = False
Set Wkb = Application.Workbooks.Open(sNomFichier, UpdateLinks:=xlUpdateLinksNever, ReadOnly:=True)
Application.DisplayAlerts = True

LastRow = Wkb.Sheets(sNomFeuilleALire).Range("A" & Rows.Count).End(xlUp).Row
LastRowPaste = iRow + LastRow - iRowDep

Wkb.Sheets(sNomFeuilleALire).Range("A3:Y" & LastRow).Copy
ThisWorkbook.Worksheets(ShMaterial.Name).Range("A" & iRow).PasteSpecial xlPasteValues

iRow = iRow + LastRow - 2

With Application
.StatusBar = "Lecture Fichiers : " & Cpt + 1 & " / " & NbFichiers
.CutCopyMode = False
End With

Wkb.Close False

Set FSO = Nothing
End Sub

Private Sub ListeFichiersDossier(sChemin As String, bInclureSousDossiers As Boolean)
Dim FSO As Object, Dossier As Object, Fichier As String
Dim sPath As String

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(sChemin)

Fichier = Dir$(sChemin & "\*.*")
Do While Len(Fichier) > 0
sPath = sChemin & "\" & Fichier
If Fichier <> ThisWorkbook.Name And UCase(TypeFichier) = UCase(FSO.GetExtensionName(Fichier)) Then
NbFichiers = NbFichiers + 1
ReDim Preserve TabFichiers(1 To NbFichiers)
TabFichiers(NbFichiers) = sPath
End If
Fichier = Dir$()
Loop

If bInclureSousDossiers Then
For Each Dossier In Dossier.SubFolders
ListeFichiersDossier Dossier.Path, True
Next Dossier
End If

Set Dossier = Nothing
Set FSO = Nothing
End Sub

Private Sub MepFinale()
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With

With ShMaterial
.Activate
.Range("C1").Select
End With
End Sub

Private Function NumCol2Lettre(ByVal NumCol As Long) As String
Dim i As Long, x As Long, s As String
Dim Max As Long
Max = Int(Log(CDbl(25 * (CDbl(NumCol) + 1))) / Log(26)) - 1
For i = Max To 0 Step -1
x = (26 ^ (i + 1) - 1) / 25 - 1
If NumCol > x Then
s = s & Chr(((NumCol - x - 1) \ 26 ^ i) Mod 26 + 65)
End If
Next i
NumCol2Lettre = s
End Function

Sub OuvertureFichiersMultiples()
Dim Fichier As Variant, i As Long

ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Excel ,*.xls", 1, _
"Sélectionner un ou plusieurs fichier(s)", , True)
If TypeName(Fichier) = "Boolean" Then
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
ShMaterial.Range("C1").Select
Exit Sub
End If

QueryPerformanceCounter Dep

Init

DoEvents
Application.ScreenUpdating = False

NbFichiers = UBound(Fichier)
For i = 1 To NbFichiers
Cpt = Cpt + 1
TestExistenceFeuille Fichier(i)
If bFlagNomFeuille = False Then
MepFinale
Application.ScreenUpdating = True
Exit Sub
End If
Next i

Cpt = 0
For i = 1 To NbFichiers
Lire Fichier(i)
Cpt = Cpt + 1
Next i

Entete
MepFinale

QueryPerformanceCounter Fin: QueryPerformanceFrequency Freq

With Application
.ScreenUpdating = True
.StatusBar = "Terminé : Fichiers " & Cpt & " / " & Format(((Fin - Dep) / Freq), "0.00 s")
End With
End Sub

Sub SelDossier()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path & "\"
.Title = "Dossier à traiter"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.ButtonName = "Sélection Dossier"
.Show
If .SelectedItems.Count > 0 Then

QueryPerformanceCounter Dep

Init

DoEvents
Application.ScreenUpdating = False

ListeFichiersDossier .SelectedItems(1), False
TestExistenceFeuilleDossier

If NbFichiers = 0 Or bFlagNomFeuille = False Then
MepFinale
Application.ScreenUpdating = True
Exit Sub
End If

LectureFichiers
Entete
MepFinale

QueryPerformanceCounter Fin: QueryPerformanceFrequency Freq

With Application
.ScreenUpdating = True
.StatusBar = "Terminé : Fichiers " & Cpt & " / " & Format(((Fin - Dep) / Freq), "0.00 s")
End With
End If

ShMaterial.Range("C1").Select
End With
End Sub

------------------------------------------------------------------------------
Ci-après le deuxième code
------------------------------------------------------------------------------

Sub Test()
Dim fd As FileDialog, Chemin As String
Dim I As Long, Import As String, Tableau As Double
Cells.Clear
I = 1
Chemin = "TEST"
While Chemin <> ""
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Add "Textes", "*.dat", 1
.FilterIndex = 1
If .Show = -1 Then
Chemin = .SelectedItems(1)
Else
GoTo Fin
End If
End With
Open Chemin For Input As #1
Do While Not EOF(1)
Line Input #1, Import
Range("A" & I & ":E" & I).Value = Split(Replace(Import, ",", "."), Chr(9))
I = I + 1
Loop
Close #1
Wend
Fin:
If I = 1 Then Exit Sub
Range("F1") = 1
Range("F1").Copy
Range("A1:E" & I - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("F1").Clear
End Sub

Remarques : Le premier code ne permet d'ouvrir que des fichiers .xls (or je veux ouvrir des fichiers .dat et/ou .txt). Je veux enregistrer tous les fichiers dans une seule feuille Excel. Le premier code permet également d'ouvrir des dossiers mais sa ne m'intéresse pas. J'ai peur de supprimer une mauvaise partie du code.

Le deuxième code ne se compile pas suite à une erreur "Erreur de compilation : Type défini par l'utilisateur non défini". Cela concerne les premières lignes de code "Dim fd As FileDialog".

Des idées d'améliorations simples sur un des deux codes ?