CODEWITHSUNDEEP
arraysexcelvbacopy
Kai
Kai

Reputation: 63

Copy specific sheets into new workbook using array

Hi everyone I need some help here, searched through forums on related topic but still couldn't figure out what is not right with the macro I have below. I am trying to copy specific sheets selected by user from a drop down list (multiple selection enabled) in cell J4. For example there are sheets named Amsterdam, Rotterdam, Koper, Long Beach and Los Angeles and user has selected Amsterdam, Koper and Long Beach from the drop down list, the value in cell J4 will be Amsterdam, Koper, Long Beach. I then use split to delimit the string to an array to copy the selected sheets however it's hitting the subscript out of range error at line ThisWorkbook.Sheets(Selection).Copy, greatly appreciate any advise.

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

Upvotes: 1

Views: 41

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Copy Worksheets to a New Workbook

  • Replace is covering the most probable cause of the error, the delimiter being , or , , the latter not being acceptable for the Split function.
  • Avoid borrowing variable names from VBA like Path, and especially Selection. Make up your own ones.
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

Upvotes: 1

Related Questions