Microsoft Office Forums - View Single Post - [Solved] Macro to create two copies of worksheet, then run macro.

NoSparks · 01-30-2019, 03:28 PM

Perhaps something like this using variables to refer to the worksheets.
When you make a copy of a sheet, the copy automatically becomes the active sheet.

Code:

Sub ThreeWaySplit()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim arr As Variant

'create copies, rename sheets
    'original sheet
    Set ws1 = ActiveSheet
    'break apart the original sheet name into an array
    arr = Split(ws1.Name, "_")
    'rename original
    ws1.Name = arr(2) & "_260"
    'first copy
    ws1.Copy After:=Sheets(1)
    ActiveSheet.Name = arr(2) & "_350"
    Set ws2 = ActiveSheet
    'second copy
    ws1.Copy After:=Sheets(2)
    ActiveSheet.Name = arr(2) & "_450"
    Set ws3 = ActiveSheet
    
'deal with original sheet
    With ws1
        .Select
        Application.Run "PERSONAL.XLS!Survey40wire"
        Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
        Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    End With
'deal with first copy
    With ws2
        .Select
        Application.Run "PERSONAL.XLS!Survey40wire"
        Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
        Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    End With
'deal with second copy
    With ws3
        .Select
        Application.Run "PERSONAL.XLS!Survey40wire"
        Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
        Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    End With
    
End Sub