Excel VBA Runtime ошибка 9 субкрита вне диапазона

Question

При закрытии книги я получаю:

Run-time error 9 subscript out of range

Это код VBA:

Set wbk = Workbooks.Open(path & filename)
  wbk.Sheets(sheetname).Range("b6").Resize(row_count, col_count).Copy
  ThisWorkbook.Sheets(sheetname).Range("b6").Resize(1, col_count).PasteSpecial xlPasteValues
wbk.close

Может ли кто-нибудь помочь мне выбраться из этой ошибки?

Answer 1

Такая ошибка указывает на то, что вы ссылаетесь на несуществующую ячейку или диапазон. В вашем случае я думаю, что проблема не закрывается, а в одной из следующих строк:

  wbk.Sheets(sheetname).Range("b6").Resize(row_count, col_count).Copy
  ThisWorkbook.Sheets(sheetname).Range("b6").Resize(1, col_count).PasteSpecial xlPasteValues

Убедитесь, что имя sheetname , row_count и col_count содержат допустимое значение.

Answer 2

Почему вы используете ".Изменить размер "метод в пасте? Я вижу, что вы пытаетесь скопировать диапазон, скажем, 3х4 ячеек и вставить их в ячейки 1х4. Это невозможно. Попробуйте без изменения размера пасты:

Set wbk = Workbooks.Open(path & filename)
  wbk.Sheets(sheetname).Range("b6").Resize(row_count, col_count).Copy
  ThisWorkbook.Sheets(sheetname).Range("b6").PasteSpecial xlPasteValues
wbk.close

В другом посте я видел способ скопировать данные из нескольких листов в один:

Public Sub CopyMultipleData()
    Dim ws  As Worksheet, LR1 As Long, LR2 As Long
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Master" Then
            LR1 = Sheets("Master").Range("A" & Rows.Count).End(xlUp).row + 1
            LR2 = ws.Range("D" & Rows.Count).End(xlUp).row
            ws.Range("A1:J" & LR2).Copy Destination:=Sheets("Master").Range("A" & LR1)
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub