Подписка вне диапазона при попытке скопировать данные рабочего листа в существующую книгу

#excel #vba

#excel #vba

Вопрос:

Я новичок в Excel VBA и пытаюсь скопировать данные с рабочего листа в существующую книгу, но не могу. Таким образом, у меня есть рабочая книга, в которой выполняется макрос, в этой же рабочей книге есть исходный рабочий лист, откуда мне нужно извлечь запись (A2:H2) , затем я проверяю, существует ли целевая рабочая книга, если не создать ее, в противном случае она должна копировать / вставлять записи в существующую рабочую книгу.

Код макроса VBA выглядит следующим образом

 Sub process()

    Dim fName As String
    Dim fExists As String
    
    Dim wb As Excel.Workbook
    
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    'Dim lCopyLastRows As Long
    Dim lDestLastRow As Long
    
    
    fName = "C:TACsResumoTACs_" amp; Format(Date, "MM-YYYY") amp; ".xlsx"
    fExists = Dir(fName)
    
    If fExists = "" Then
        '\ Create a new workbook
        Set wb = Workbooks.Add
        
        '\ Copy sheet to the new workbook
        ThisWorkbook.Sheets("TAC Data").Copy Before:=wb.Sheets(1)
        
        '\ Delete unused sheet
        Application.DisplayAlerts = False
        wb.Sheets(2).Delete
        Application.DisplayAlerts = True
        
        '\ Save new workbook
        wb.SaveAs fileName:=fName, FileFormat:=xlOpenXMLStrictWorkbook
        ActiveWorkbook.Save
        ActiveWorkbook.Close

        MsgBox "New file " amp; fName amp; " created!"
    Else
        '\ Set variables for copy and destinnation sheets
        Set wsCopy = ThisWorkbook.Worksheets("TAC Data")
        Set wsDest = Workbooks(fName) 'Worksheets("TAC Data")
        
        '\ Find first blank row in the destination range based on data in column B
        lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
        
        '\ Copy amp; Paste Data
        wsCopy.Range("A2:H2").Copy _
            wsDest.Range("A" amp; lDestLastRow)

        MsgBox "The file exists"
    End If

    On Error Resume Next
    Application.Dialogs(xlDialogPrint).Show
    
End Sub

  

Когда я пытаюсь запустить макрос VBA, я получаю следующую ошибку при выполнении кода Set wsDest = Workbooks(fName) 'Worksheets("TAC Data") :
Ошибка времени выполнения ‘9’:
Подписка вне диапазона

введите описание изображения здесь

Есть идеи по поводу проблемы или как я мог бы эффективно скопировать данные рабочего листа в существующую книгу?

Комментарии:

1. Индекс вне диапазона указывает, что лист не найден, но вы все равно пытаетесь его использовать. Если вы выделите ThisWorbook.Sheets("TAC Data") в отдельную WorkSheet переменную, вы обнаружите, что она не найдена, и поэтому вы не можете вызвать ее .Copy метод.

2. Спасибо за помощь. Есть предложения о том, как добавить данные с рабочего листа в другую книгу?

Ответ №1:

Здесь несколько проблем:

  1. Целевая книга может быть открыта, а может и нет. Если это не так, откройте его
  2. В целевой книге может быть или не быть листа с именем «Данные TAC».
  3. wsDest — это рабочий лист, а не рабочая книга, поэтому вам нужно указать рабочий лист (как в вашем комментарии)
  4. При обращении к открытой книге укажите только название книги, без пути
 Dim fPath as String
'...
fPath = "C:TACs"
fName = "ResumoTACs_" amp; Format(Date, "MM-YYYY") amp; ".xlsx"
fExists = Dir(fPath amp; fName)
'...
If fExists = "" Then
    '...
Else
    On Error Resume Next
    Set wbDest = Workbooks(fName) ' now that fName contains only the file name
    On Error GoTo 0
    If wbDest Is Nothing Then
        'Open it
        Set wbDest = Workbooks.Open(fPath amp; fName)
    End If
End If
'...
On Error Resume Nest
Set wsDest = wbDest.Worksheets("TAC data")
On Error GoTo 0
If wsDest Is Nothing Then
    ' Sheet missing.  What now?
Else
    '...