将excel文件列表合并到一个新的Excel工作簿中(Merge a list of excel files into a new excel book)

将excel文件列表合并到一个新的Excel工作簿中(Merge a list of excel files into a new excel book)

我需要创建一个宏来合并目录中的excel文件列表。 该文件夹包含我不想选择的其他文件。 所以，我需要指定文件列表（例如，选择名称中包含“ 02.08 .xlsx”的所有文件）。

这是我第一次使用VBA，所以请考虑到这一点。 我尝试了一些东西，但我认为我总是遇到有关文件选择的问题。

这是我到目前为止尝试过的，但不起作用：

Sub MergeWorkbooks() Dim FolderPath As String Dim Filename As String Dim ListFilenames As Variant Dim Sheet As Worksheet Application.ScreenUpdating = False FolderPath = CurDir() ListFilenames = Array("*02.08.02.01*.xlsx", "*02.08.13.01*.xlsx") For i = 1 To 2 Filename = Dir(FolderPath & ListFilenames(i)) Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Next i Application.ScreenUpdating = True End Sub

I need to create a macro that merges a list of excel files in a directory. The folder contains other files that I don't want to pick. So, I need to specify the list of files (such as, selecting all the files which name contains "02.08.xlsx").

This is my first time using VBA, so please take that into consideration. I've tried some things, but I think I always get problems regarding the files selection.

Here's what I've tried so far, but not working:

Sub MergeWorkbooks() Dim FolderPath As String Dim Filename As String Dim ListFilenames As Variant Dim Sheet As Worksheet Application.ScreenUpdating = False FolderPath = CurDir() ListFilenames = Array("*02.08.02.01*.xlsx", "*02.08.13.01*.xlsx") For i = 1 To 2 Filename = Dir(FolderPath & ListFilenames(i)) Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Next i Application.ScreenUpdating = True End Sub

最满意答案

代码就是这样的。

Sub MergeWorkbooks() Dim FolderPath As String Dim Filename As String Dim ListFilenames As Variant Dim Sheet As Worksheet Application.ScreenUpdating = False FolderPath = CurDir() ListFilenames = Array("*02.08.02.01*.xlsx", "*02.08.13.01*.xlsx") For i = 0 To 1 Filename = Dir(FolderPath & "\" & ListFilenames(i)) Do While Filename <> "" Workbooks.Open Filename:=FolderPath & "\" & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop Next i Application.ScreenUpdating = True End Sub

The code is wouldb be like this.

Sub MergeWorkbooks() Dim FolderPath As String Dim Filename As String Dim ListFilenames As Variant Dim Sheet As Worksheet Application.ScreenUpdating = False FolderPath = CurDir() ListFilenames = Array("*02.08.02.01*.xlsx", "*02.08.13.01*.xlsx") For i = 0 To 1 Filename = Dir(FolderPath & "\" & ListFilenames(i)) Do While Filename <> "" Workbooks.Open Filename:=FolderPath & "\" & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop Next i Application.ScreenUpdating = True End Sub