copy and paste objects to multiple sheets (2007)

[steveh]

Hi all

I have one object with a hyperlink and another with a macro that I want to place on about 112 different sheets. If I copy them both and then select all of the sheets in the workbook it doesn't allow me to paste them. Rather than manually copy and paste to each individual sheet is there a macro that could be run to place Bevel 1 and Bevel 2 onto every sheet in the workbook?

Cheers

[Rudi]

Here is a very rudimentary macro that should do what you ask.
You just need to change the names in the array statement below to the names of the buttons in your sheet. Check the names in the names box after clicking your shape.

Image 1.png

Note: The macro assumes the shapes are on sheet 1 and will copy them to sheets 2 till the last sheet.

Code: Select all

Sub CopyButtons()
Dim i As Integer
    Application.ScreenUpdating = False
    'Change the names in the array below to refer to your button names
    Worksheets(1).Shapes.Range(Array("Rectangle 1", "Rounded Rectangle 2")).Select
    Selection.Copy
    'Copy the buttons on sheet 1 to all other sheets from sheet 2 to the last sheet
    For i = 2 To ThisWorkbook.Worksheets.Count
        With Worksheets(i)
            .Select
            .Range("B2").Select
            .Paste
            .Range("A1").Select
        End With
    Next i
    Worksheets(1).Select
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "Buttons copied.", vbInformation
End Sub

[steveh]

Hi Rudi

Thank you for this however it produces an error when run. I wonder if it is because each sheet has an individual name (although in the VB window it does show for example Sheet 1 (staff details))

Cheers

[Rudi]

Hi,

Try replacing this line:

Code: Select all

Worksheets(1).Shapes.Range(Array("Bevel 1", "Bevel 2")).Select

with this line:

Code: Select all

Worksheets(1).Shapes.Range(Array(1, 2)).Select

The macro assumes the shapes are on sheet 1 (and does not consider the names of the sheets). If the sheet containing the shapes is named staff details, you could try replacing Worksheet(1) with Worksheets("Staff Details"), like this:

Code: Select all

Worksheets("Staff Details").Shapes.Range(Array(1, 2)).Select

However, please note that the macro will still loop through sheets 2 to the last sheet and copy the buttons onto these.