【问题标题】:excel vba merge multiple sheets from multiple workbooks into one workbookexcel vba将多个工作簿中的多个工作表合并到一个工作簿中
【发布时间】:2017-08-09 07:59:57
【问题描述】:

我有两个 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

我必须打开两个工作簿,这没问题。工作表“Store 1”被很好地复制然后停止,当我点击调试时,它告诉我这一行有错误

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

错误消息:“脚本超出范围”

【问题讨论】:

  • 每个打开的工作簿中是否有一个名为“Store 1”的工作表(目的地除外)?如果没有,它将无法在它查找的下一个工作簿中找到该工作表并导致失败。
  • 不,它只在一个工作簿中,而不是另一个 - 我明白了,它在每个工作簿中寻找同一张工作表!如何将其更改为仅从一个工作簿中获取一个工作表并从另一个工作簿中获取另一个工作表?
  • 您需要指定哪个工作簿具有哪个工作表,而不是执行 For Each wkb 来循环工作簿。如果您事先不知道名称,则必须继续使用 For Each 循环,但请检查以确保工作簿包含您要复制的工作表。如果确实包含工作表,则复制它,否则跳过
  • 我是 VBA 的新手,您有代码示例或查找信息的好网站吗?非常感谢mcuh

标签: vba excel


【解决方案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

【讨论】:

    最近更新 更多