VBA 代码 |打开文件夹中的所有文件，运行格式化 VBA 代码，然后将所有文件合并到一个电子表格中

Question

我的文件夹中有几个 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 个代码合二为一。

Answer 1

1. 在您的文件夹位置创建一个主文件并将其命名为“1. File Consolidator”。确保主文件打开的文件夹中的所有文件均为 .xlsb 格式（或者如果不同，请更改下面代码中的扩展名类型）。

2. 打开主文件并将选项卡重命名为“File Consolidator”。

3. 创建一个将在其中运行的宏：

Sub AllFiles()
    Dim folderPath As String
    Dim filename As String
    Dim wb As Workbook
    Dim wb2 As Workbook
    
    folderPath = ActiveWorkbook.Path
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    
    filename = Dir(folderPath & "*.xlsb")
    Do While filename <> ""
      Application.ScreenUpdating = False
        Set wb2 = Workbooks.Open(folderPath & filename)
        
         
        'Call a subroutine here to operate on the just-opened workbook
         Call tb_cleanup
        'Call 2nd subroutine to copy and paste opened workbook into master file
         Call GenFileToCall
        
        
        filename = Dir
    Loop
  Application.ScreenUpdating = True
  MsgBox ("File Consolidator ran successfully")
End Sub

创建第二个宏“GenFileToCall”（在上面调用），将打开的工作簿复制到主文件中：

Sub GenFileToCall()
Set wb = Application.Workbooks("1. File Consolidator.xlsm")
Set wb2 = Application.ActiveWorkbook


If ActiveSheet.FilterMode Then wb2.Sheets("Sheet1").ShowAllData
       
    
'Find last row in wb2
With wb2.Sheets("Sheet1")
    'Lastrow = .Range("A:AS" & .Rows.Count).End(xlUp).Row
     Lastrow = .Range("A:AS").Find("*", , , , xlByRows, xlPrevious).Row
End With

    
'Copy range from A1:K until last row then close
wb2.Sheets("Sheet1").Range("A2:AS" & Lastrow).Copy

Application.DisplayAlerts = False
'Make wb1 active workbook again
wb.Activate
'Find last row in wb1
With wb.Sheets("File Consolidator")
   'Lastrow = .Range("A:AS" & .Rows.Count).End(xlUp).Row
    Lastrow = .Range("A:AS").Find("*", , , , xlByRows, xlPrevious).Row
End With
'Paste in wb1 after last row
wb.Sheets("File Consolidator").Range("A" & Lastrow + 1).PasteSpecial xlPasteValues
wb.Sheets("File Consolidator").Range("A" & Lastrow + 1).PasteSpecial xlPasteFormats
'Close wb2 (Test File)
wb2.Close


End Sub