Код VBA | Откройте все файлы в папке, запустите форматирование кода VBA, затем объедините все в одну таблицу

У меня есть несколько файлов Excel в папке, которые мне нужно отформатировать, а затем полученные файлы объединить в одну основную таблицу.

1. У меня есть код для открытия всех файлов в указанной папке следующим образом:

Sub Open_Workbooks()

    Dim myPath As String
    Dim myFile As String
    Dim wb As Workbook
    
    ' Specify the folder path containing the Excel files
        myPath = "C:\Users\Kuda\Documents\TRIAL BALANCES"
    
    
    ' Check for trailing backslash in folder path
        If Right(myPath, 1) <> "\" Then myPath = myPath & "\"
    
    
    ' Find the first Excel file in the folder
    myFile = Dir(myPath & "*.xls*")
    
    
    ' Loop through all Excel files in the folder
    Do While myFile <> ""
        ' Open the workbook
        Set wb = Workbooks.Open(myPath & myFile)
        
        ' Move to the next file (this line is essential to avoid an endless loop)
        myFile = Dir
    Loop
End Sub

2. Код форматирования будет:

Call tb_cleanup()

3. Теперь мне нужен третий код, который применяет код №2 ко всем открытым электронным таблицам, а затем копирует отформатированные данные из каждой открытой электронной таблицы, а затем вставляет их, укладывая их один за другим в одну главную электронную таблицу.

#4 Четвертый код — это один код в единственном числе, который объединяет все три вышеперечисленных кода в одном.

Итак, могу ли я получить помощь с кодом для пунктов 3 и 4, как указано выше.

Код для tb-cleanup:

Sub tb_cleanup()

Dim A, B


If Range("D11").Value <> "Account" Then

    MsgBox "Not applicable here.", vbOKOnly, "FOR TB ONLY!!"
    Exit Sub
    
End If

Application.ScreenUpdating = False

    
    A = Range("A2").Value
    B = Range("B2").Value
    
    
    Cells.Select
    Selection.UnMerge
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    
    
    Rows("1:10").Select
    Range("A10").Activate
    Selection.Delete Shift:=xlUp
    
    Range("G1").Value = "Business Unit"
    Range("H1").Value = "Month"
    Range("I1").Value = "Year"
    
Dim xRow
xRow = Cells.Find(What: = "*", After:=Range("A1"), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
         
         
Dim k

k = xRow - 5

    ' delete last unnec rows
    Rows(k & ":" & xRow).Select
    Selection.Delete Shift:=xlUp
    
    

xRow = Cells.Find(What: = "*", After:=Range("A1"), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
         
         
    'put BU + Date

    Range("G2:G" & xRow).FormulaR1C1 = A
    
    Range("H2:H" & xRow).FormulaR1C1 = Format(B, "MMM")
    Range("I2:I" & xRow).FormulaR1C1 = Format(B, "yyyy")
    
    
    Range("G2").Select
    
    Range("B2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWindow.FreezePanes = True
    
    Range("A1:I" & xRow).Select
    Selection.Columns.AutoFit
   
    Range("G2").Select
    
    Call myTable
    
xRow = Cells.Find(What: = "*", After:=Range("A1"), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
         

    Range("B2:B" & xRow).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
        Selection.InsertIndent 1
        
        
        ActiveWindow.Zoom = 75
    Range("A1:I" & xRow).Select
    Selection.RowHeight = 18
    
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = -1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    With Selection.Font
        .Name = "Aptos Display"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMajor
    End With
    
    With Selection.Font
        .Name = "Aptos Display"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMajor
    End With
    
    Range("D2:F" & xRow).Select
    Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    
    Range("A1:I" & xRow).Select
    Selection.Columns.AutoFit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
       
    
    
    Range("A1").Select
    Application.ScreenUpdating = True

 
End Sub

вызов myTable выглядит следующим образом:

Sub myTable()

    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Cells.EntireColumn.AutoFit

    Range("A1").Select
    
    
    
End Sub