excel - 从多个工作簿导入多个​​命名工作表

Question

我正在尝试从不同的工作簿导入多个​​工作表，用于不同的场景。为了更好地解释 - 我有 Apple、Banana 和 Cherry 的场景。每个方案都有自己的文件夹，其中包含工作簿一、二和三。工作簿一有工作表 Jack、John 和 Jill。工作簿二有工作表 Rachel、Robin 和 Ryan。工作簿 3 有工作表 Sam、Sally 和 Susan。工作表名称不会因场景而异。

主工作簿有一个不同场景的下拉列表和一个从每个工作簿中引入的工作表列表（例如，下拉列表选择的是场景 Apple，范围包括 - 从工作簿一个导入 Jack 和 Jill，从工作簿两个导入 Robin ，并从工作簿三导入 Sam 和 Susan）。

参见图片了解主工作簿布局：

代码需要转到相应的场景文件夹（在代码中称为 Run），然后打开每个工作簿并拉入相应的工作表。现在我得到

运行时错误9：下标超出范围

上Workbooks(Masterbook)=Workbooks(Databook)线。

我是否过于复杂了？任何建议将不胜感激！

Sub CopySheetsfromCRSS()

Dim MasterBook As String
Dim wb As Workbook
Dim DataBook As String
Dim CurrentPullSheet As String
Dim DataDumpSheet As String
Dim PasteSheet As String
Dim OneRange As Range
Dim TwoRange As Range
Dim ThreeRange As Range
Dim TypesOfData As Range
Dim CopyRange As String
Dim Locations As Range
Set OneRange = Range("B1", Range("B1").End(xlDown))
Set TwoRange = Range("C1", Range("C1").End(xlDown))
Set ThreeRange = Range("D1", Range("D1").End(xlDown))

Application.ScreenUpdating = False

'Read in Range of Copy Data'
Let CopyRange = "A1:DI517"
'Read range of sheets to Pull'
Set TypesOfData = Range("A1", Range("A1").End(xlDown))

MasterBook = ActiveWorkbook.Name

With ThisWorkbook.ActiveSheet
'Type of Data Loop'
For i = 1 To TypesOfData.Rows.Count
    If i = 1 Then
        'One'
        Set Locations = OneRange
        ElseIf i = 2 Then
        'Two'
        Set Locations = TwoRange
        Else
        'Three'
        Set Locations = ThreeRange
    End If

'Run Loop'
    For j = 1 To Rows.Count
        If j = 1 Then
        RunCell = "E1"
        End If
        CurrentRun = .Range(RunCell).Value
        'Open Workbook'
        Workbooks.Open ThisWorkbook.Path & "\Runs\" & CurrentRun & "\" & CurrentRun & "_" & TypesOfData.Cells(i, 1) & ".xlsx"
        DataBook = ActiveWorkbook.Name
            For k = 1 To Locations.Rows.Count
                'Copy Data'
                CurrentPullSheet = Locations.Cells(k, 1)
                PasteSheet = "Data_" & CurrentPullSheet
                Workbooks(MasterBook).Sheets(PasteSheet).Range(CopyRange).Value = Workbooks(DataBook).Sheets(CurrentPullSheet).Range(CopyRange).Value
            Next
        'Close Workbook'
        Workbooks(MasterBook).Activate
        For Each wb In Application.Workbooks
            If Not Not wb.Name <> ActivateWorkbook.Name Then
            If wb.Name Like "*.xls" Then
                wb.Close SaveChanges:=True
                Else
                wb.Close
            End If
            End If
        Next
    Next
Next
End With
End Sub

标签： excelvba