VBA遍历文件夹下的文件并且合并工作簿到一个工作簿中

这里整合指把Sheet移动到一个workbook中。

没有覆盖到子文件夹中的文件。

Sub Test()

Debug.Print (ThisWorkbook.Path)

Dim p, stockcode As String
Dim f

p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xlsx") '遍历文件夹下的文件


  Do While f <> ""
        If f <> ThisWorkbook.Name Then
        
        stockcode = Mid(f, 11, 9)
        Debug.Print (p & f)
        Debug.Print (stockcode)
        Workbooks.Open Filename:=p & f 'open
        Sheets("已恢复_Sheet1").Move After:=Workbooks("新建 Microsoft Excel 工作表.xlsm").Sheets(ThisWorkbook.Worksheets.Count) '需要移动到最后一个。这里的Sheet名称全部都是“已恢复_Sheet1”
        
        Sheets("已恢复_Sheet1").Name = stockcode
        'ActiveWorkbook.Close
        
        'Debug.Print (f)
        End If
        f = Dir()
  Loop
  Debug.Print (ThisWorkbook.Worksheets.Count)

End Sub