VBA for copy several worksheets with similar name (except for last character) to a new workbook

[chika235]

Hi guys,

I hope you could please help me with this. I have tried everything i could to make the below codes work but it hasn't gone very well

I have a workbook of 4 worksheets: ALPHA, BETA, ALPHA1, BETA1.

All I wanted to do is to have 2 workbooks:

- Copy both ALPHA & ALPHA1 into a new workbook, and name the new workbook as ALPHA (which is the 1st sheet name) - 1st workbook
- Copy both BETA & BETA1 into a new workbook, and name the new workbook as BETA (which is the 1st sheet name) - 2nd workbook

Originally, i have tried to use this code:

Sub Test1()
'
' Test1 Macro

    Dim ws As Worksheet
    Dim oldwb As Workbook
    Dim newwb As Workbook
    
    Set oldwb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\ALPHABETA.xlsx")
    
    Application.ScreenUpdating = False

    For Each ws In oldwb.Sheets
    
    If ws.Name Like "ALPHA*" Then
    
        ws.Copy
        Application.DisplayAlerts = False
    
        ActiveWorkbook.SaveAs Filename:=oldwb.Path & "\" & ActiveSheet.Name, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close False
    
    ElseIf ws.Name Like "BETA*" Then
    
    ws.Copy
    Application.DisplayAlerts = False
    
        ActiveWorkbook.SaveAs Filename:=oldwb.Path & "\" & ActiveSheet.Name, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close False
    
    Else
    
    oldwb.Activate
    
    End If
    
    Next ws
    
    oldwb.Close False

    End Sub

The problem with "Test1" (or the above code) is that it extracts every single worksheets into single workbooks (i.e: end result I have 4 workbooks: ALPHA, ALPHA1, BETA, BETA1).

I went on and thought maybe I tried a bit of an old way, by saying that I mean less automated (but automated)

Sub Test2()
'
' Test2 Macro
'

'

    Dim ws As Worksheet
    Dim oldwb As Workbook
    Dim newwb As Workbook
    
    Set oldwb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\ALPHABETA.xlsx")
    
    Application.ScreenUpdating = False

    Sheets(Array("ALPHA", "ALPHA1")).Select
    Selection.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=oldwb.Path & "\" & ActiveSheet.Name, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close False

    Sheets(Array("BETA", "BETA1")).Select
    Selection.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=oldwb.Path & "\" & ActiveSheet.Name, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWorkbook.Close False

    oldwb.Close False

    End Sub

This Test2 gave a new workbook with all ALPHA, ALPHA1, BETA, BETA1 worksheet copied into the same workbook (DO ABSOLUTELY NOTHING except for saving the oldwb as ALPHA workbook).

I don't know what I have gone WRONG, and seriously curious to know how I could fix this to make it work? Still a novice to VBA so either code is OK for as long as it works

Thanks all in advance and if my post is too long - my sincere apologies.

Chika.

 

[chika235]

-bump-