合并一个文件夹内所有excel文件到一个工作簿VBA

nnsea

'打开任意一个Excel工作簿，通过【Ctrl+N】新建一个工作簿，点击【Alt+F11】进入宏代码界面，将以下代码复制到新建的工作簿对应的ThisWorkbook的模块中，修改对应路径，然后点F5运行即可。

Sub MergeMultiWorkBooks()

Dim FolderPath As String

Dim Filename As String

Dim Sheet As Worksheet

Application.ScreenUpdating = False

' 修改如下路径为需要合并的文件夹所在路径

FolderPath = "C:\Users\Yeo\Desktop\Test\"

Filename = Dir(FolderPath & "*.xls*")

On Error Resume Next

Do While Filename <> ""

Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True

For Each Sheet In ActiveWorkbook.Sheets

   Sheet.Copy After:=ThisWorkbook.Sheets(1)

   ActiveSheet.Name = Left(Filename, InStrRev(Filename, ".") - 1)

Next Sheet

Workbooks(Filename).Close

Filename = Dir()

Loop

Application.DisplayAlerts = False

ThisWorkbook.Sheets(1).Delete

ActiveWorkbook.SaveCopyAs FolderPath & "MergedFile.xlsx"

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub