复制多个工作表时，下标超出范围错误VBA

Question

我有一个VBA功能，用于从活动工作簿中复印工作表的列表并将其保存。我得到下标超出范围错误。任何帮助，将不胜感激？

Private Sub exporttoexcel(excelFileName) 
excelFileName = 'File in my local' 
Dim mySheetList() As String 
Dim WS As Worksheets 
Dim WB As Workbook 
MsgBox excelFileName 
'Dim sourceWB As Workbook 
'Dim destWB As Workbook 
' 
'Set sourceWB = ActiveWorkbook 
'sourceWB.Sheets.Copy 
' 
'Set WB = Workbooks(excelFileName) 
    ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1) 
    Dim a As Integer 
     a = 0 

     For Each WS In ActiveWorkbook.Worksheets 
      mySheetList(a) = WS.Name 
      a = a + 1 
     Next 

Dim Fileobj 
Set Fileobj = CreateObject("Scripting.FileSystemObject") 
If Fileobj.FileExists(excelFileName) Then 
    Fileobj.DeleteFile excelFileName 
End If 

'  'actually save 
    Worksheets(mySheetList).Copy '<<<<<<< RUN-TIME ERROR 9 RAISED HERE 
    ActiveWorkbook.SaveAs FileName:=excelFileName 
    'MsgBox excelFileName 

    'ThisWorkbook.SaveAs FileName:=excelFileName, FileFormat:=xlXMLSpreadsheet 
    Application.Wait (Now + TimeValue("0:00:15")) 
    WB.Close 

End Sub 

Answer 1

我想你已经通过了片表的名称列表，即“工作表Sheet1”，“Sheet2的”，等等。但是，在传递数组时，必须使用函数Sheets(Array(mySheetList))。

'Worksheets(mySheetList).Copy 
Sheets(Array(mySheetList)).Copy 

Answer 2

这适用于我，我会尝试适应你的excelfilename。 ws作为工作表变暗也存在问题。我将来会使用Option Explicit。

Private Sub exporttoexcel() 
'excelFileName = 'File in my local' 
Dim mySheetList() As String 
Dim WS 
Dim WB As Workbook 
MsgBox excelFileName 
'Dim sourceWB As Workbook 
'Dim destWB As Workbook 
' 
'Set sourceWB = ActiveWorkbook 
'sourceWB.Sheets.Copy 
' 
'Set WB = Workbooks(excelFileName) 
    ReDim mySheetList(0 To (ThisWorkbook.Sheets.count) - 1) 
    Dim a As Integer 
     a = 0 

     For Each WS In ThisWorkbook.Worksheets 
      mySheetList(a) = WS.Name 
      a = a + 1 
     Next 

Dim Fileobj 
Set Fileobj = CreateObject("Scripting.FileSystemObject") 
If Fileobj.FileExists(excelFileName) Then 
    Fileobj.DeleteFile excelFileName 
End If 

'  'actually save 
    Sheets(mySheetList).Copy 
    ActiveWorkbook.SaveAs Filename:=excelFileName 
    'MsgBox excelFileName 

    'ThisWorkbook.SaveAs FileName:=excelFileName, FileFormat:=xlXMLSpreadsheet 
    Application.Wait (Now + TimeValue("0:00:15")) 
    WB.Close 

End Sub