Copy Sheets to new workbook using Wildcards

akash14

New Member
Joined
Oct 15, 2013
Messages
19
Hello,

I want to copy worksheets from current workbook to a new workbook. The names of Worksheet have format: Name-Month
Ex: Adam-Mar, Adam-Apr, John-Mar, John-Apr.

Now what I am trying to do is copy all Adam sheets to one workbook and all John Worksheets to another.

The code which I currently use only copy one sheet. I don't know how to create an array of all sheets with same name and then copy it. My current code is:
Code:
Do While Not IsEmpty(Cells(i, 1))
         save_name = Cells(i, 1)
         sname = Cells(i, 1) & "-" & Sheets("Cal").Cells(3, 4)
         Sheets(sname).Copy
         'saving the file code

save_name is the name of the person (Adam,John). And Sheets("Cal").Cells(3,4) actually had the value "Mar" and it saved all sheets with Name-Mar with the Loop(Since there was only one sheet per name). But now to copy multiple sheets I need to create an array and I have no idea how to do it. Is it possible to copy all sheets with Adam-* to one workbook.

Any help will be appreciated. Thanks
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Gavin T

Well-known Member
Joined
Mar 26, 2014
Messages
836
This would work:

Code:
Sub Copy_Sheets()

    Dim wSheet      As Worksheet
    Dim arrJohn()   As String
    Dim arrAdam()   As String
    Dim i           As Integer
    Dim j           As Integer

    
    For Each wSheet In ThisWorkbook.Worksheets
        If wSheet.Name Like "John*" Then
            ReDim Preserve arrJohn(i)
            arrJohn(i) = wSheet.Name
            i = i + 1
        ElseIf wSheet.Name Like "Adam*" Then
            ReDim Preserve arrAdam(j)
            arrAdam(j) = wSheet.Name
            j = j + 1
        End If
    Next wSheet

    With ThisWorkbook
        .Activate
        Sheets(arrJohn).Copy Before:=Workbooks("[COLOR="#FF0000"][B]Book1.xlsx[/B][/COLOR]").Sheets([COLOR="#FF0000"][B]1[/B][/COLOR])
        .Activate
        Sheets(arrAdam).Copy Before:=Workbooks("[COLOR="#FF0000"][B]Book2.xlsx"[/B][/COLOR]).Sheets([COLOR="#FF0000"][B]1[/B][/COLOR])
    End With
End Sub

Remember to change the code colored red to match your specific needs.
 

akash14

New Member
Joined
Oct 15, 2013
Messages
19
Thanks Gavin. Works perfectly. I just had to Erase the array everytime because I am using it in a while loop because I have a lot of names and I didn't want to write For loop for each of them.

Thanks again. I really appreciate your help.
 

Forum statistics

Threads
1,136,640
Messages
5,676,942
Members
419,660
Latest member
Fred Cailloux

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top