VBA - copy worksheet to another workbook if the sheet name matches partially

[aaltomar]

I have a source file (open workbook, not saved to a location) which can have 6 to xx number of sheets.

The source file sheet names usually follow the logic of:
Overview, Components, System-1, Hints-1, System-2, Hints-2, System-3, Hints-3,... Add-on products, Hints-12, Services etc...

I need to copy all the sheets from this source file where the names are as:

• System-1
• System-2
• System-...n
• + in adddition also "Add-on products" if it exists, there is only one if there are but there could be none

Up to possibly even 20 "System*" sheets but there could be as few as only one. So all the sheets where the sheetname starts with "System-*" need to be copied to another open workbook where the macro is activated from. The source file name can change, but it's usually Book1, Book2, Book6 etc, it depends. I'd say there's only one workbook open named Book(x) open at any given time so the source name usually starts the same.

The workbook to where I want to have the sheets copied to has already five existing sheets and the new sheets need to be copied after these.
The workbook where the sheets are to be copied to can be named in a certain fashion if it can't be generalized to a "template.xlsb" etc

The code that I've been testing really hasn't gotten me very far and I've spent some hours on this already googling the internet:

Sub copy_sheets()
    
    Dim ws As Worksheet

    Windows("Book2").Activate

    For Each ws In ActiveWorkbook.Sheets
        If InStr(1, ws.Name, "System*") Then
          
           ActiveWorkbook.Sheets("System*").Copy _
           After:=Workbooks("copyto").Sheets(5)
        
        End If
    Next
End Sub

 

[aaltomar]

One small thing that I just noticed, the macro actually imports the sheets twice. As we have two variants it may be looping the code per variant?

 

[aaltomar]

Solved with additional code (hack):

    For Each ws In ThisWorkbook.Sheets
        If UCase(Right(ws.Name, 3)) = "(2)" Then
            ws.Delete
        End If
    Next