Собрать данные из папки с кучей CSV - VBA

Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
 
Sub FILES_FROM_FOLDER()
    Application.Calculation = xlCalculationManual
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    ToBook = ActiveWorkbook.Name
 
    Set ToSheet = ActiveSheet
    NumColumns = ToSheet.Range("A1").End(xlToRight).Column
    ToRow = ToSheet.Range("A65536").End(xlUp).Row
 
    If ToRow <> 1 Then
        ToSheet.Range(ToSheet.Cells(2, 1), _
            ToSheet.Cells(ToRow, NumColumns)).ClearContents
    End If
    ToRow = 2
 
    FromBook = Dir("*.csv")
    While FromBook <> ""
        If FromBook <> ToBook Then
            Application.StatusBar = FromBook
            Transfer_data
        End If
        FromBook = Dir
    Wend
 
    MsgBox ("Done.")
    Application.StatusBar = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Private Sub Transfer_data()
    Workbooks.Open Filename:=FromBook
    For Each FromSheet In Workbooks(FromBook).Worksheets
        LastRow = FromSheet.Range("A65536").End(xlUp).Row
 
        FromSheet.Range(FromSheet.Cells(2, 1), _
            FromSheet.Cells(LastRow, NumColumns)).Copy _
            Destination:=ToSheet.Range("A" & ToRow)
 
        ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    Next
    Workbooks(FromBook).Close savechanges:=False
End Sub