VBA help - copy array of sheets to new workbook using dictionary

[Mallesh23]

Hi Team,

I want copy all sheets except Sheet1 to New workbook and want to save that workbook.
using dictionary approach.

Thisworkbook.Sheets(Array("SheetName1", "SheetName2", "SheetName3", "SheetName4")).Copy

Sub Copyallsheets()

Dim ws As Worksheet
Dim dict As New Scripting.dictionary

'Add sheetname to dictionary for copying

For Each ws In ThisWorkbook.Worksheets

    If UCase(ws.Name) <> "SHEET1" Then
           
        dict.Add ws.Name, Empty
   
    End If

Next ws

'Add new workbook and copy sheets

Dim nwbk As Workbook
Set nwbk = Workbooks.Add

ThisWorkbook.Sheets([B]Array(dict.Keys))[/B].Copy After:=nwbk.Worksheets("Sheet1")

'Thisworkbook.Sheets(Array("SheetName1", "SheetName2", "SheetName3", "SheetName4")).Copy


End Sub

Thanks
mg

 

[Fluff]

How about

ThisWorkbook.Sheets(dict.Keys).Copy After:=nwbk.WorkSheets("Sheet1")

 

[Mallesh23]

Hi Fluff,

So sweet one line code, Thanks for your help, it worked


Thanks
mg

 

[Fluff]

You're welcome & thanks for the feedback.