将工作表复制并合并到工作簿答案

【问题标题】：Copy and combine sheets to a workbook将工作表复制并合并到工作簿
【发布时间】：2018-09-12 00:57:06
【问题描述】：

我需要 Excel 的 VBA 代码：将由空工作簿中的按钮激活，循环打开工作簿，仅从工作簿复制名为“特定工作表名称”的工作表并将其粘贴到按钮激活器工作簿中的新工作表中。所以想法是它将来自不同工作簿的许多工作表组合成一个工作簿。我试过这个：

Sub workbookFetcher()

Dim book As Workbook, sheet, wsNew, wsCurr As Worksheet

Set wsCurr = ActiveSheet

For Each book In Workbooks
    For Each sheet In book.Worksheets
        If sheet.Name = "COOLING_RAW" Then
            Set wsNew = Sheets.Add(After:=wsCurr)
            book.Worksheets("COOLING_RAW").Copy
            Set wsNew = book.Worksheets("COOLING_RAW")
        End If
    Next sheet
Next book

End Sub

它有点工作，但它将所有复制的工作表粘贴到新工作簿。这不是我想要的，我希望将它们粘贴到同一个工作簿中。

【问题讨论】：

两个不同的问题需要作为两个单独的问题发布...但只有在您搜索后 Google 和此网站才能获得类似问题的现有答案问题。这些都是非常常见的任务。如果您遇到特定的问题，您需要包含您的代码以及示例数据、您尝试过的具体内容以及一些背景信息。请参阅“minimal reproducible example”和“How to Ask”。
编辑为一个问题。我从互联网上找到的只是将数据粘贴到新工作簿的东西。
您正在添加一个新工作表，然后将工作表设置为等于该工作表。我认为你真正想做的是book.Worksheets("COOLING_RAW").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 或类似的东西。根本不需要Set wsNew 的东西。

标签： vba excel

【解决方案1】：

正如我在评论中所说：

Sub workbookFetcher()

Dim book As Workbook, sheet as Worksheet

For Each book In Workbooks
    For Each sheet In book.Worksheets
        If sheet.Name = "COOLING_RAW" Then
            book.Worksheets("COOLING_RAW").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        End If
    Next sheet
Next book

End Sub

如果您希望它位于 ActiveSheet 之后并且 ActiveSheet 位于其他工作表的中间，您仍然可以使用您的 wsCurr 并增加索引。

【讨论】：

【解决方案2】：

如果您拥有 Excel 2016，那么功能区的“获取和转换”部分下新捆绑的 PowerQuery 功能是目前执行此操作的最佳方式。建议您在 Google 上搜索 PowerQuery Combine Workbooks 之类的内容，您会看到大量优秀的教程，向您展示具体的操作。它几乎使大量 VBA 变得多余，与 VBA 相比，它是儿童游戏。

如果您拥有 2010 年以后的任何其他版本的 Excel 并且在您的计算机上拥有管理员权限，您可以从 Microsoft 的网站下载并安装 PowerQuery...这是一个免费插件

【讨论】：

【解决方案3】：

您无需遍历每个工作簿工作表，而只需尝试获取所需的工作表并复制它（如果它确实存在）

此外，您还想避免在ThisWorkbookitsel 中搜索所需的工作表！

Option Explicit

Sub workbookFetcher()
    Dim book As Workbook, sht As Worksheet

    For Each book In Workbooks
        If book.Name <> ThisWorkbook.Name Then ' skip ThisWorkbook and avoid possible worksheet duplication 
            If GetWorksheet(book, "COOLING_RAW", sht) Then sht.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ' if currently searched workbook has wanted worksheet then copy it to ThisWorkbook
        End If
    Next
End Sub

Function GetWorksheet(book As Workbook, shtName As String, sht As Worksheet) As Boolean
    On Error Resume Next ' prevent subsequent statement possible error from stoping the function
    Set sht = book.Worksheets(shtName) ' try getting the wanted sheet in the passed workbook
    GetWorksheet = Not sht Is Nothing ' return 'True' if successfully got your sheet in the passed workbook
End Function

【讨论】：