Copying and pasting two different groups of shapes on every sheet

  • Hello,


    My goal for this program is to copy and paste these groups onto every sheet in a workbook, and then replace certain cells with the groups if they have a key phrase.


    However, when I run my code currently instead of pasting both of the groups it only pastes twice whichever one is selected first.


    Any clues on how to help?
    [VBA]Sub CopyGroups()
    CopyShape1
    CopyShape2





    End Sub


    Sub CopyShape2()


    Dim X As Integer


    WS_Count = ActiveWorkbook.Worksheets.Count


    For X = 2 To (WS_Count)


    ActiveWorkbook.Worksheets(1).Shapes.Range(Array("Group 4")).Select


    Selection.Copy


    'Reference Sub Active Cell, Column 2


    BlankRowActive X, 2



    ActiveSheet.Paste



    Next X
    End Select



    Application.CutCopyMode = False
    End Sub



    Sub CopyShape1()


    Dim X As Integer


    WS_Count = ActiveWorkbook.Worksheets.Count


    For X = 2 To (WS_Count)


    ActiveWorkbook.Worksheets(1).Shapes.Range(Array("Group 1")).Select

    Selection.Copy


    'Reference Sub Active Cell, Column 1


    BlankRowActive X, 1



    ActiveSheet.Paste

    Next X
    End Select


    Application.CutCopyMode = False


    End Sub


    Sub BlankRowActive(SheetNum As Integer, Column As Integer)



    Dim lRow As Integer



    lRow = ActiveWorkbook.Worksheets(SheetNum).Cells.Find(What:="*", _
    After:=Range("A1"), _
    LookAt:=xlPart, _
    LookIn:=xlFormulas, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious, _
    MatchCase:=False).Row

    lRow = lRow + 1


    Worksheets(SheetNum).Select



    ActiveSheet.Cells(lRow, Column).Select


    End Sub
    [/VBA]

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!