Macro to copy sheets to new WB in a specific order fails

[Tim Hanson]

Hello,
I am trying to save sheets to a new WB in the order they lised in the Array.

I get the first sheet in the If statment but it fails on the else statment I get "Script out of range" Here:

Worksheets(SheetsArr(I)).Copy _
     Before:=Workbooks(GenWorkbookName).Sheets(SheetsArr(UBound(SheetsArr)))

I can not figure out what I am doing wrong

Thanks

Sub SaveSheetsAsNewBookByList()
Dim SheetsArr As Variant
Dim ws As Worksheet, wsN As Worksheet
Dim WorkbookName As String, MyFilePath As String, FileName As String, GenWorkbookName As String
Dim I As Long
 
'goFast False
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
     
    WorkbookName = "MyFile Name"
    MyFilePath = ThisWorkbook.Path & "\" & WorkbookName
 
    If Len(Dir(MyFilePath, vbDirectory)) = 0 Then
      MkDir MyFilePath
    End If
 
    'Array of Sheet Names To Copy To New WB
    SheetsArr = Array("DDD", "AAA", "ZZZ")
 
    'Copy Over Sheets To New WB
    For I = UBound(SheetsArr) To LBound(SheetsArr) Step -1
        If I = UBound(SheetsArr) Then
          Worksheets(SheetsArr(I)).Copy
          'Get Name of the New Generated WB
            GenWorkbookName = ActiveWorkbook.Name
 
    Else
      Worksheets(SheetsArr(I)).Copy Before:=Workbooks(GenWorkbookName).Sheets(SheetsArr(UBound(SheetsArr)))
    End If
    Next I
       
    'Activate New Work Book
    Workbooks(GenWorkbookName).Activate
    With ActiveWorkbook
        '~save book in this folder
        ActiveWorkbook.SaveAs FileName:=MyFilePath & "\" & WorkbookName & "_" & Format(Now(), "DD-MM-YY hh.mm") & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close SaveChanges:=True
    End With

    Sheets(1).Select
'goFast True
End Sub

 

[Gary's Student]

This will copy the sheets from the original workbook to a newly created workbook in the desired order:

Sub dural()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim i As Long
    Set wb1 = ActiveWorkbook
    Workbooks.Add
    Set wb2 = ActiveWorkbook
    ary = Array("DDD", "AAA", "ZZZ")
    i = 1
    For Each a In ary
        wb1.Sheets(a).Copy After:=wb2.Sheets(i)
        i = i + 1
    Next a
End Sub

 

[NARAYANK991]

Hi Tim ,

The mistake is in this statement :

Worksheets(SheetsArr(I)).Copy Before:=Workbooks(GenWorkbookName).Sheets(SheetsArr(UBound(SheetsArr)))

If you change the highlighted portion as follows :

Worksheets(SheetsArr(I)).Copy Before:=Workbooks(GenWorkbookName).Sheets(SheetsArr(I + 1))

it should work.

The problem with the earlier usage is that it is a fixed number ; in the second usage what we are telling Excel is to copy the sheet before the earlier sheet ; thus the order is as follows :

First , the sheet ZZZ will be copied

Next , the sheet AAA is copied before the sheet ZZZ

Next , the sheet DDD is copied before the sheet AAA

This results in the sheet order being DDD , AAA , ZZZ which is the order in the array.

Narayan

 

[Tim Hanson]

Thank you Gary's Student a more elegent way then mine

Thank you Narayan for the explination of what I was missing that helped alot

 

[Smallman]

Hi Tim

A non looping alternative.

Sub Goski()
  Sheets(Array("DDD", "AAA", "ZZZ")).Copy
End Sub

Copies to a fresh workbook in the desired order.

Take care

Smallman