使用数组将特定工作表复制到新工作簿中

Question

大家好，我在这里需要一些帮助，搜索了相关主题的论坛，但仍然无法弄清楚我下面的宏有什么问题。我正在尝试从单元格 J4 的下拉列表（启用多项选择）中复制用户选择的特定工作表。例如，有名为阿姆斯特丹、鹿特丹、科佩尔、长滩和洛杉矶的工作表，用户从下拉列表中选择了阿姆斯特丹、科佩尔和长滩，单元格 J4 中的值将是阿姆斯特丹、科佩尔、长滩。然后我使用 split 将字符串分隔为一个数组以复制选定的工作表，但是它在 ThisWorkbook.Sheets(Selection).Copy 行遇到下标超出范围错误，非常感谢任何建议。

Sub MainPage_Button2_Click()
Dim Path As String, Filename1 As String, ddVal As String, ddList() As String, Selection As Variant
Application.ScreenUpdating = False
    Path = "G:\Dept\sales\"
    Filename1 = Range("A2").Value
    ddVal = Range("J4")
    ddList = Split(ddVal, ",")
    Selection = Array(ddList)
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(Selection).Copy
    ActiveWorkbook.SaveAs Filename:=Path & Filename1 & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

将工作表复制到新工作簿

• Replace 涵盖了最可能的错误原因，分隔符为 , 或 , ，后者不适用于 Split 函数。
• 避免从 VBA 中借用变量名称，例如 Path，尤其是 Selection。自己制作。

Option Explicit

Sub MainPage_Button2_Click()
    
    Const dPath = "G:\Dept\sales\"
    
    Application.ScreenUpdating = False
    
    Dim dName As String: dName = Range("A2").Value
    Dim dwsNamesList As String: dwsNamesList = Range("J4").Value
    Dim dwsNames() As String
    dwsNames = Split(Replace(dwsNamesList, ", ", ","), ",")
    
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(dwsNames).Copy
    ActiveWorkbook.SaveAs dPath & dName & ".xlsx", xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True

End Sub