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

Question

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

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

создает новую книгу в том же каталоге файла Excel, который содержит код (далее «исходный файл»)
сохраняет новую книгу как _export.xlsx
копирует некоторые предопределенные листы из исходного файла в файл "* _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 ... Сначала я подумал о какой-то синтаксической ошибке в определении массива листов, поэтому я попытался написать отдельный. Скопируйте инструкцию для каждого листа. Один и тот же код прерывается в той же точке с той же ошибкой.

Любая идея? Спасибо!

# vba excel arrays

fabbius05 авг. 2020, в 15:52

Источник

Поделиться в социальных сетях:

Скопировать адрес страницы:

Ответы 2

Смежные вопросы

siggi_pop · Answer 1 · 2020-08-05T13-34-00.000Z

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

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

Chronocidal · Answer 2 · 2020-08-05T13-13-45.000Z

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

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