move each sheet to an open workbook based on name

Hi Shanna
:If the sheet name contains "100" move it to the open workbook
I use copy method because if the Sheet name contains "100" is the last one of thisbook then error message will be shown.
If you want Sheet to "move" then
Please replace the word "copy" "move".

Sub Sample()
Const strWrd As String = "100"
Dim WB As Workbook, WS As Worksheet
For Each WS In Worksheets
If InStr(WS.Name, strWrd) > 0 Then
For Each WB In Workbooks
If InStr(WB.Name, strWrd) > 0 Then
WS.Copy After:=WB.Sheets(WB.Sheets.Count)
ActiveSheet.Name = "QTD"
End If
Next
End If
Next
End Sub

Hi Colo

I was wondering how to change this so that the sheet name is not hardcoded. Say I want excel to look at the sheet name and then copy it to the open workbook that contains that string.

I have numerous sheets, all with different 3-digit code's as their names, so saying it will be "100" doesn't help. I tried writing it over and over again for all the different numbers, but am getting tripped up on how many End If's and Next's I need.

Perhaps there's any easier way???

Thanks :-)
Shanna

Sub Sample2()
Dim strShName As String, WB As Workbook, WS As Worksheet
For Each WS In Worksheets
If IsNumeric(WS.Name) And Len(WS.Name) = 3 Then
For Each WB In Workbooks
If InStr(WB.Name, WS.Name) > 0 Then
WS.Copy After:=WB.Sheets(WB.Sheets.Count)
ActiveSheet.Name = "QTD"
End If
Next
End If
Next
End Sub