mise en forme de données

Sub importAvec_AssistantTEXTpourFormat()
Dim a As Workbook, b As Workbook
Dim chemin$: chemin = "C:\TEMP\": Set a = ThisWorkbook
Dim i As Long
Application.ScreenUpdating = False
    With a
        With .Sheets(1)
            For i = 1 To .[A65536].End(xlUp).Row
                Workbooks.OpenText Filename:=.Cells(i, 1).Text, Origin:=xlWindows, _
                    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                    ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
                    , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), Array(2, 2), _
                    Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
                    Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
                    16, 1), Array(17, 1))
                    Set b = ActiveWorkbook
                    b.ActiveSheet.UsedRange.Copy a.Sheets(2).[A65536].End(xlUp).Offset(1)
                    b.Close True
            Next
        End With
        With .Sheets(2)
            .Rows("1:1").EntireRow.Delete
            With .[A1].CurrentRegion
                .Columns.AutoFit
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
            End With
        End With
    End With
Application.ScreenUpdating = True
End Sub

Sub importtxt()

    Dim myDir$, fn$, txt$, sepa$, a(), dl As Long
    Dim n As Long, i As Long, j As Long, ff As Integer
    Dim d As Worksheet
    sepa = ";": myDir = ThisWorkbook.Path & "\"
    With ActiveWorkbook.Worksheets("Menu")
    For j = 1 To .[A1].End(xlUp).Row
        ff = FreeFile
        Open myDir & .Cells(j, 1).Text For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            n = n + 1: ReDim Preserve a(1 To n)
            a(n) = Split(txt, sepa)
         Loop
        Close #ff
      Next j
      End With
      Set d = ActiveWorkbook.Worksheets("IMPORTATION")
        With d
            With .[A1]
                For i = 1 To n
                    .Offset(i - 1).Resize(, UBound(a(i)) + 1).Value = a(i)
                Next
                dl = d.[A65536].End(xlUp).Row
                .Resize(dl).TextToColumns Destination:=Range("A1"), _
                    DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, _
                    ConsecutiveDelimiter:=False, _
                    Tab:=False, _
                    Semicolon:=False, _
                    Comma:=False, _
                    Space:=False, _
                    Other:=False, _
                    FieldInfo _
                    :=Array(1, 4)
                .Offset(, 1).Resize(dl).NumberFormat = "h:mm"
            End With
        End With
End Sub

Sub Macro4()
Dim j As Long, a As Workbook, donnees As Range
Dim chemin$
chemin = "C:\TEMP\" 'ici mettre le nom du répertoire désiré
With ActiveWorkbook
    With Worksheets("Menu")
        For j = .[A65536].End(xlUp).Row To 1 Step -1
        Workbooks.OpenText chemin & .Cells(j, 1).Text, _
        Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1))
            Set a = ActiveWorkbook
            Set donnees = a.Sheets(1).[A1].CurrentRegion
            donnees.Copy ThisWorkbook.Sheets("IMPORTATION").[A65536].End(xlUp)(2)
            a.Close False
            Set a = Nothing
            Set donnees = Nothing
            Application.CutCopyMode = False
            Next j
    End With
.Worksheets("IMPORTATION").Rows(1).Delete
End With
End Sub