Subscript out of range error - VBA error

问题

I keep getting subscript out of range for the following code, I'm new to VBA so would greatly appreciate your help.

I'm trying to reference a table that contains various source workbooks and copy the data from here to "target" workbooks also contained in the sTable range.

Thanks, Ronan

Sub Import()
    Dim sTable As String                              ' Source table
    Dim sTarget As String                             ' Target range for output
    Dim sHeader As String                             ' Header row from the input data
    Dim sFileName As String                           ' File name to read from
    Dim tFileName As String
    Dim sInputSheet As String                         ' Worksheet to read from
    Dim sRange As String                              ' Range to read from/copy
    Dim tSheet As String
    Dim tRange As String                              ' Range to paste into/Target Range
    Dim sRow As Integer
    Dim cRow As Integer

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False

    'Define source(s) and target(t) sheets
    sTable = "rng_SourceData"
    'loop through source table to copy and paste requred data
    sRow = Range(sTable).Rows.Count

    For cRow = 1 To sRow
    'loop through source table to copy and paste requred data
    sRow = Range(sTable).Rows.Count
    For cRow = 1 To sRow


        sFileName = Worksheets("I.Import").Range(sTable).Cells(cRow, 1)
        sInputSheet = Worksheets("I.Import").Range(sTable).Cells(cRow, 2)
        sRange = Worksheets("I.Import").Range(sTable).Cells(cRow, 3)
        tFileName = Worksheets("I.Import").Range(sTable).Cells(cRow, 4)
        tRange = Worksheets("I.Import").Range(sTable).Cells(cRow, 5)
        tSheet = Worksheets("I.Import").Range(sTable).Cells(cRow, 6)

        'Include all ranges in the input table
        Call ImportDataSpreadsheet(sFileName, sInputSheet, sRange, tSheet, tRange)


    Next cRow

End Sub

Sub ImportDataSpreadsheet(sFileName, sInputSheet, sRange, tSheet, tRange)
    Dim SourceWorkbook As Excel.Workbook
    Dim TargetWorkbook As Excel.Workbook
    Dim TargetSheet As Excel.Worksheet

    'Define Source workbook
    Set SourceWorkbook = Workbooks.Open(Filename:=sFileName, Password:=False)
    'Select.Workbook.Sheets.Open (sInputSheet)
    Application.ScreenUpdating = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    'Copy
    SourceWorkbook.Sheets(sInputSheet).Activate
    SourceWorkbook.Sheets(sInputSheet).EnableSelection = xlNoRestrictions

    SourceWorkbook.Sheets(sInputSheet).Range(sRange).Copy

    'Define Target workbook
    Set TargetWorkbook = ThisWorkbook.Worksheets("I.Import").Range(sTable).Cells(cRow, 4)
    Set TargetSheet = TargetWorkbook.Sheets(tSheet)

    'Paste
    TargetWorkbook.Sheets(tSheet).Range(tRange).PasteSpecial Paste:=xlPasteValues

    'Close and finish.
    SourceWorkbook.Close savechanges:=False

End Sub

回答1:

The problem is caused because, when you Open a new workbook, you are changing what is the ActiveWorkbook and your code is by default using ActiveWorkbook because you aren't qualifying your Worksheets collections to say which workbook they really refer to.

The easiest way to fix this is to just create a reference to which workbook was active when you started the code:

'Define source(s) and target(t) sheets
sTable = "rng_SourceData"

Dim wbTable As Workbook
Set wbTable = ActiveWorkbook

'Shorten some code by using a With block
With wbTable.Worksheets("I.Import").Range(sTable)
    'loop through source table to copy and paste requred data
    sRow = .Rows.Count
    For cRow = 1 To sRow

        sFileName = .Cells(cRow, 1)
        sInputSheet = .Cells(cRow, 2)
        sRange = .Cells(cRow, 3)
        tFileName = .Cells(cRow, 4)
        tRange = .Cells(cRow, 5)
        tSheet = .Cells(cRow, 6)

        'Include all ranges in the input table
        ImportDataSpreadsheet sFileName, sInputSheet, sRange, tSheet, tRange

    Next cRow
End With

Because the code is now always referring to wbTable, which has been set prior to any other workbooks being opened, the code will refer to the correct sheet.

---

Note: Theoretically, we don't really need wbTable, we could just use a

With ActiveWorkbook.Worksheets("I.Import").Range(sTable)

block, but my personal preference it to set that temporary object instead.

来源：https://stackoverflow.com/questions/47802080/subscript-out-of-range-error-vba-error