Select 多个工作簿，将每个工作簿中的第一个选项卡合并到同一工作簿中的新选项卡，使用文件名重命名选项卡

Question

目标：

Select 多个带有文件查找器的工作簿（工作中）
首先将每个工作簿中的 Sheet 合并到同一工作簿中的新选项卡（错误）
使用它来自的工作簿的文件名重命名新选项卡（工作）

来源：

我在互联网上搜索了不同的代码，但没有找到完成所有这些的代码，我敢肯定它就在某处。我发现了几个相似的不同 Stack 页面，并尝试将它们组合起来。

VBA script to consolidate multiple excel sheets into one sheet
Combine first sheet of multiple workbooks into one workbook

完整代码：

Sub OpeningFiles()

Dim SelectedFiles As FileDialog
Dim NumFiles As Long, FileIndex As Long
Dim TargetBook As Workbook
Dim Path As String

'prompt user to select a file or multiple files
Set SelectedFiles = Application.FileDialog(msoFileDialogOpen)

With SelectedFiles
    .AllowMultiSelect = True
    .Title = "Pick the files you'd like to consolidate:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xls files", "*.xls"
    .Show
End With

'check to see if user clicked cancel
If SelectedFiles.SelectedItems.Count = 0 Then Exit Sub

'start the loop over each file
NumFiles = SelectedFiles.SelectedItems.Count
For FileIndex = 1 To NumFiles

'set a reference to the target workbook
Set TargetBook = Workbooks.Open(SelectedFiles.SelectedItems(FileIndex))

'consolidate
    Do While TargetBook <> ""
        Set Path = TargetBook.Path
        Workbooks.Open TargetBook:=Path & TargetBook, ReadOnly:=True
        With ActiveWorkbook
            .Worksheets(1).Copy after:=ThisWorkbook.Sheets(1)
            ThisWorkbook.Sheets(2).Name = .Name
        End With
        Workbooks(TargetBook).Close
        TargetBook = Dir()
    Loop
    
    TargetBook.Close SaveChanges:=False
Next FileIndex


End Sub

问题：

Do While TargetBook <> ""
    Set Path = TargetBook.Path
    Workbooks.Open TargetBook:=Path & TargetBook, ReadOnly:=True

当我合并代码时这里出了点问题，我不确定是什么。我想我需要引用所选文件的文件路径，但我不确定如何按照此代码的设置方式进行操作。我在 Set Path 上收到一个需要对象的错误。我什至不确定我是否需要这样做，或者是否有其他方法可以在不需要路径对象的地方构建 Workbooks.Open TargetBook:=Path & TargetBook, ReadOnly:=True。

Answer 1

对于以后可能偶然发现此问题的任何人，这里是工作代码：

Sub OpeningFiles()

Dim SelectedFiles As FileDialog
Dim NumFiles As Long, FileIndex As Long
Dim TargetBook As Workbook
Dim Path As String

'prompt user to select a file or multiple files
Set SelectedFiles = Application.FileDialog(msoFileDialogOpen)

With SelectedFiles
    .AllowMultiSelect = True
    .Title = "Pick the files you'd like to consolidate:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xls files", "*.xls"
    .Show
End With

'check to see if user clicked cancel
If SelectedFiles.SelectedItems.Count = 0 Then Exit Sub

'start the loop over each file
NumFiles = SelectedFiles.SelectedItems.Count
For FileIndex = 1 To NumFiles

'set a reference to the target workbook
Set TargetBook = Workbooks.Open(SelectedFiles.SelectedItems(FileIndex))

'consolidate
        With TargetBook
            .Worksheets(1).Copy after:=ThisWorkbook.Sheets(1)
            ThisWorkbook.Sheets(2).Name = .Name
        End With
   
    TargetBook.Close SaveChanges:=False
Next FileIndex


End Sub

Answer 2

来自@SJR的评论：像这样-

'...
NumFiles = SelectedFiles.SelectedItems.Count
For FileIndex = 1 To NumFiles

    'open workbook for a "With" block
    With Workbooks.Open(SelectedFiles.SelectedItems(FileIndex))
        .Worksheets(1).Copy after:=ThisWorkbook.Sheets(1)
        ThisWorkbook.Sheets(2).Name = .Name
        .Close False 'no save
    End With

Next FileIndex
'...

Select 多个工作簿，将每个工作簿中的第一个选项卡合并到同一工作簿中的新选项卡，使用文件名重命名选项卡

Select Multiple Workbooks, Merge First tab in each workbook to NEW tabs in same workbook, Rename tab with Filename

excel

merge

vba

filepath