how to code "if tab name starts with a string, then move these tabs to a new workbook"

[lynnsong986]

Hello,

I have a workbook with over 60 tabs, example of their names:

111100
111100A
111100Detail
111100B
213100
213100Detail
213100A
131460
131460Detail
312504
312504Detail
312504Ele
312504Wat
312504Gas

so they all start with a 6-digit code and they all have a code+Detail tab, but other than that, some can have more tabs and others don't. I have the list of the 6-digit on Sheet1 such as:

111100
213100
312504

what I need is for the codes to copy tabs starting with each of these values, i.e.

111100
111100A
111100Detail
111100B
will be copied to a new workbook

213100
213100Detail
213100A
will be copied to a new workbook

312504
312504Detail
312504Ele
312504Wat
312504Gas
will be copied to a new workbook

131460 will be copied at all because it is not on the list.

I don't know how to code this line: "if the tab name start with the cell value, then copy it", I'm not sure how to use * in this case. can someone please show me how to code this part?

thanks so much,

 

[JoeMo]

Not clear to me whether "will be copied to a new workbook" means each sheet gets its own workbook or all the sheets with the listed 6-digit prefix go to one new workbook. Below is some code you can adapt depending on which you want. As written, the code will select all sheets that have the listed prefixes so you can then move or copy them to one new workbook.

Sub test10()
Dim TabsToMove, Sht As Worksheet, i As Long
TabsToMove = Array(111100, 213100, 312504) ' List the 6-digit prefix of all tabs to move here
For Each Sht In ThisWorkbook.Worksheets
    For i = LBound(TabsToMove) To UBound(TabsToMove)
        If Sht.Name Like TabsToMove(i) & "*" Then
        'remove the replace argument if you want to move each sheet to a new workbook
            Sht.Select Replace:=False
        End If
    Next i
Next Sht
'All sheets now selected
'your code here to create a new workbook and move them to it
End Sub

 

[lynnsong986]

Not clear to me whether "will be copied to a new workbook" means each sheet gets its own workbook or all the sheets with the listed 6-digit prefix go to one new workbook. Below is some code you can adapt depending on which you want. As written, the code will select all sheets that have the listed prefixes so you can then move or copy them to one new workbook.

Sub test10()
Dim TabsToMove, Sht As Worksheet, i As Long
TabsToMove = Array(111100, 213100, 312504) ' List the 6-digit prefix of all tabs to move here
For Each Sht In ThisWorkbook.Worksheets
    For i = LBound(TabsToMove) To UBound(TabsToMove)
        If Sht.Name Like TabsToMove(i) & "*" Then
        'remove the replace argument if you want to move each sheet to a new workbook
            Sht.Select Replace:=False
        End If
    Next i
Next Sht
'All sheets now selected
'your code here to create a new workbook and move them to it
End Sub

thanks so much for your help!! this is exactly what I need!

 

[JoeMo]

thanks so much for your help!! this is exactly what I need!

You are welcome - thanks for the reply.