Question

我有两个excel工作簿，我需要从一个工作表中取出一组工作表，从另一个工作表中取出一组工作表，并将其另存为新工作簿。由于我将每周进行此操作，因此我想将其保存为宏/ vba。

我在网上找到了这段代码并对其进行了编辑，但它无效。

Sub CopySheets()
    Dim wkb As Workbook
    Dim sWksName As String

sWksName = "Store 1"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing

    sWksName = "Store 3"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing

    sWksName = "Store 30"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing

    sWksName = "Store 33"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing


End Sub

我必须打开两个工作簿，这没问题。表＆＃34;商店1＆＃34;被复制得很好，然后停止，当我点击调试时，它告诉我这行有错误

 wkb.Worksheets(sWksName).Copy _
              Before:=ThisWorkbook.Sheets(1)

错误消息：＆＃34;脚本超出范围＆＃34;

Answer 1

Sub CopySheets()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sWsNames As String

    sWsNames = "Store 1,Store 3,Store 30,Store 33"

    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            For Each ws In wb.Sheets
                If InStr(1, "," & sWsNames & ",", "," & ws.Name & ",", vbTextCompare) > 0 Then
                    ws.Copy Before:=ThisWorkbook.Sheets(1)
                End If
            Next ws
        End If
    Next

End Sub

excel vba将多个工作簿中的多个工作表合并到一个工作簿中

1 个答案: