Concaténer des feuilles xls dans une seule feuille

Option Explicit
Sub test()
Dim i As Byte
Application.ScreenUpdating = False
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Données"
For i = 1 To Sheets.Count - 1
    With Sheets(i)
        .Range("A1").Resize(.Range("A65536").End(xlUp).Row, 1).Copy _
            Sheets("Données").Range("A65536").End(xlUp)(2)
    End With
Next i
Application.ScreenUpdating = True
End Sub

Sub ConcatenerMesFeuilles

Sheets.Add
With ActiveSheet
    .Name = "Données"
    .Move Before:=Sheets(1)
End With

j = 1

For NFeuille = 2 To Sheets.Count

    i = 1
 
    While Sheets(NFeuille).Cells(i, 1) <> ""
        Sheets("Données").Cells(j, 1) = Sheets(NFeuille).Cells(i, 1)
        i = i + 1
        j = j + 1
    Wend

Next

End Sub

'Option Explicit
Sub test_concatene_Pierrot()
Dim i As Byte 'attention si Sup à plus de 255 mettre un autre type
'Stop
Application.ScreenUpdating = False
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Données"
n = 167
For i = 1 To 167 'Sheets.Count - 1
iNom = i & "txt"
    With Sheets(iNom)
        .Range("A1").Resize(.Range("A65536").End(xlUp).Row, 1).Copy _
            Sheets("Données").Range("A65536").End(xlUp)(2)
    End With
Next i
Application.ScreenUpdating = True
End Sub
Sub ConcatenerMesFeuilles_Geo()
Sheets.Add
With ActiveSheet
    .Name = "Données"
    .Move Before:=Sheets(1)
End With
j = 1
For NFeuille = 1 To 167 'Sheets.Count
iNom = NFeuille & "txt"
    i = 1
' Stop
    While Sheets(iNom).Cells(i, 1) <> ""
        Sheets("Données").Cells(j, 1) = Sheets(iNom).Cells(i, 1)
        i = i + 1
        j = j + 1
    Wend
Next
End Sub

Sub MJ13()
Application.ScreenUpdating = False
Dim K As Long, i As Long
Dim Tableau()
K = 1
ReDim Tableau(1)
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Données"
For Each F In ActiveWorkbook.Worksheets
    If F.Name  "Données" And IsNumeric(Left(F.Name, 1)) Then
        For i = 1 To F.Cells(Rows.Count, "A").End(xlUp).Row
            Tableau(K) = F.Cells(i, 1)
            K = K + 1
            ReDim Preserve Tableau(K)
        Next i
    End If
Next F
For i = 1 To K
    Cells(i, 1).Value = Tableau(i)
Next i
Application.ScreenUpdating = True
End Sub

Sub Concatène_Efgé()
Application.ScreenUpdating = False
Dim K As Long, i As Long
Dim Tableau()
K = 1
ReDim Tableau(1)
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "DonnéesEfgé"
For Each F In ActiveWorkbook.Worksheets
    If F.Name <> "Données" And Right(F.Name, 3) = "txt" Then
        For i = 1 To F.Cells(Rows.Count, "A").End(xlUp).Row
            Tableau(K) = F.Cells(i, 1)
            K = K + 1
            ReDim Preserve Tableau(K)
        Next i
    End If
Next F
For i = 1 To K
    Cells(i, 1).Value = Tableau(i)
Next i
Application.ScreenUpdating = True
End Sub

Sub MJ13_2()
Application.ScreenUpdating = False
Dim K As Long, i As Long
Dim Tableau()
K = 1
ReDim Tableau(K)
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Données"
For Each F In ActiveWorkbook.Worksheets
    If F.Name  "Données" And Right(F.Name, 3) = "txt" Then
        For i = 1 To F.Cells(Rows.Count, "A").End(xlUp).Row
            Tableau(K) = F.Cells(i, 1)
            K = K + 1
            ReDim Preserve Tableau(K)
        Next i
    End If
Next F
Range("A1").Resize(UBound(Tableau)) = Application.Transpose(Tableau)
Application.ScreenUpdating = True
End Sub