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

时间:2018-04-02 19:27:47

标签: excel vba excel-vba

我需要用于Excel的VBA代码:将由空工作簿中的按钮激活,循环打开工作簿,仅复制名为" specificsheetname"从工作簿中将其粘贴到按钮激活器工作簿中的新工作表中。因此,它的想法是将来自不同工作簿的许多工作表组合成一个工作簿。我试过这个:

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

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

3 个答案:

答案 0 :(得分:0)

正如我在评论中所说:

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并只增加索引。

答案 1 :(得分:0)

如果你有Excel 2016,那么Get& amp;转换部分功能区是迄今为止最好的方法。建议你谷歌类似PowerQuery Combine Workbooks,你会看到很多很棒的教程,告诉你究竟该怎么做。它几乎使VBA变得多余,与VBA相比,它可以让孩子玩耍。

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

答案 2 :(得分:0)

您不需要遍历每个工作簿工作表,而只是尝试获取所需工作表并在实际存在时将其复制

此外,您也希望避免在ThisWorkbook itsel中搜索想要的工作表!

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