Excel VBA: массив листов, копирование из одной книги в другую

Question

Я пытаюсь написать простую подпрограмму VBA, которая:

1. создает новую книгу в том же каталоге файла excel, который содержит код (далее «исходный файл»)
2. сохраняет новую книгу как _export.xlsx
3. копирует некоторые предопределенные листы из исходного файла в файл «* _export».

Это то, что я получил в то время:

Sub export()

Dim myPath, folderPath, fileName, exportFileFullPath As String
Dim arrayOfSheetsToCopy As Variant

folderPath = Application.ActiveWorkbook.Path
fullPath = Application.ActiveWorkbook.FullName
fileName = Replace(Application.ActiveWorkbook.Name, ".xlsm", "")

exportFileFullPath = folderPath & "\" & fileName & "_export.xlsx"

Workbooks.Add
ActiveWorkbook.SaveAs fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

arrayOfSheetsToCopy = Array("originalSheet1", "originalSheet2", "originalSheet3")

Workbooks(fullPath).Sheets(arrayOfSheetsToCopy).Copy After:=Workbooks(exportFileFullPath).Sheets(Sheets.Count)

End Sub

Код, кажется, работает до тех пор, пока не появится ошибка «Индекс вне допустимого диапазона» в Таблицах (arrayOfSheetsToCopy). Копировать ... Первоначально я подумал о какой-то синтаксической ошибке в определение массива листов, поэтому я попытался написать отдельную инструкцию .Copy для каждого листа. Тот же код прерывается в той же точке с той же ошибкой.

Есть идеи? Спасибо!

Answer 1

Это работает для меня

Sub export()

    Dim myPath, folderPath, fileName, exportFileFullPath As String
    Dim arrayOfSheetsToCopy As Variant
    Dim sht As Worksheet
    Dim newWorkBook As Workbook
    
    
    folderPath = Application.ActiveWorkbook.Path
    fullPath = Application.ActiveWorkbook.FullName
    fileName = Replace(Application.ActiveWorkbook.Name, ".xlsm", "")
    fileName = Replace(fileName, ".xlsx", "")
    
    exportFileFullPath = folderPath & "\" & fileName & "_export.xlsx"
    
    Set newWorkBook = Workbooks.Add
    
    Call newWorkBook.SaveAs(fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False)
    
    For Each sht In ThisWorkbook.Sheets
    
        Call sht.Copy(after:=newWorkBook.Sheets(Sheets.Count))
    
    Next sht
    
    Call newWorkBook.Close(saveChanges:=True)

End Sub

или если вы хотите использовать предопределенные имена листов

For Each sheetName In Array("originalSheet1", "originalSheet2", "originalSheet3")

    Call ThisWorkbook.Sheets(sheetName).Copy(after:=newWorkBook.Sheets(Sheets.Count))

Next sheetName

Answer 2

Workbook.FullName не возвращает допустимый аргумент для коллекции Workbooks.

Вы можете проверить это, запустив ?Workbooks(ActiveWorkbook.FullName).FullName в окне немедленного выполнения - это приведет к ошибке. С другой стороны, Workbook.Name работает , поэтому ?Workbooks(ActiveWorkbook.Name).FullName не будет ошибкой. Другими словами, Workbooks("C:\Users\fabbius\Documents\SomeFile.xlsx") недействителен, а Workbooks("SomeFile.xlsx") - действителен, пока открыт файл с таким именем.

Однако я не вижу преимущества использования FullName при использовании правильно определенных объектов книги:

Sub export()
    Dim exportFileFullPath As String, arrayOfSheetsToCopy As Variant
    Dim wsExportFrom As Workbook, wsExportTo As Workbook
    
    Set wsExportFrom = ActiveWorkbook
    Set wsExportTo = Workbooks.Add
    
    exportFileFullPath = Replace(wsExportFrom.FullName, ".xlsm", "_export.xlsx", Len(wsExportFrom.Path))
    'The Len() is in case the File Path contains ".xlsm" for some reason
    
    wsExportTo.SaveAs fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
    arrayOfSheetsToCopy = Array("originalSheet1", "originalSheet2", "originalSheet3")
    
    wsExportFrom.Sheets(arrayOfSheetsToCopy).Copy after:=wsExportTo.Sheets(wsExportTo.Sheets.Count)
End Sub

Конечно, если этот макрос запускается из книги, из которой вы собираетесь экспортировать, то With и ThisWorkbook сделать вещи еще проще:

Sub export()
    Dim exportFileFullPath As String, arrayOfSheetsToCopy As Variant
    
    exportFileFullPath = Replace(ThisWorkbook.FullName, ".xlsm", "_export.xlsx", Len(ThisWorkbook.Path))
    'The Len() is in case the File Path contains ".xlsm" for some reason

    arrayOfSheetsToCopy = Array("originalSheet1", "originalSheet2", "originalSheet3")

    With Workbooks.Add
        
        .SaveAs fileName:=exportFileFullPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
        ThisWorkbook.Sheets(arrayOfSheetsToCopy).Copy after:=.Sheets(.Sheets.Count)
    
    End With
End Sub

Заключительное примечание: вы сохраняете файл до того, как добавляете в него рабочие листы. Должны ли эти строки быть наоборот?