VBA does not work if I copied the worksheet

[musicfreer]

Hi,

I have a VBA which works fine in original worksheet with a button. However, when I copied the worksheet, the button is still referencing to the original worksheet. I am totally new to coding. Please teach me how to correct the VBA or button.

Thank you

Sub InsertPicsr1()
Dim fPath As String, fName As String
Dim r As Range

Application.ScreenUpdating = False
fPath = "E:\listings\listing photo\"
For Each r In Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)
    On Error GoTo errHandler
    If r.Value <> "" Then
        With ActiveSheet
                .Shapes.AddPicture fPath & r.Value & ".jpg", _
                msoFalse, msoTrue, _
                .Cells(r.Row, 2).Left, _
                .Cells(r.Row, 2).Top, _
                .Columns(2).Width, _
                .Rows(r.Row).Height
        
        End With
    End If
errHandler:
If Err.Number <> 0 Then
    Debug.Print Err.Number & ", " & Err.Description & ", " & r.Value
    On Error GoTo -1
End If
Next r
Application.ScreenUpdating = True
End Sub

 

[musicfreer]

Should I put the VBA in a standalone worksheet, and all the other worksheet reference to that VBA worksheet? Sorry I am not even sure if this makes sense.

 

[nemmi69]

The code will run in which ever the active sheet workbook is in. If its a specific workbook, worksheet this needs to be specified.

 

[musicfreer]

The code will run in which ever the active sheet workbook is in. If its a specific workbook, worksheet this needs to be specified.

thanks. I made a button to link the VBA, but when I copied the worksheet, the button on the new worksheet still links to the VBA of the original worksheet. How can I correct it?

 

[nemmi69]

I found this

Public Sub FixCopiedButtonMacroLinks(ByVal theSheet As Worksheet)
    ' UPDATED: by HackSlash to accept a worksheet parameter.
    'PURPOSE: Remove an external workbook reference from all shapes triggering macros
    'Source: www.TheSpreadsheetGuru.com

    Dim control As Shape
    Dim MacroLink As String
    Dim SplitLink As Variant
    Dim NewLink As String

    'Loop through each shape in worksheet
    For Each control In theSheet.Shapes

        'Grab current macro link (if available)
        MacroLink = control.OnAction

        'Determine if shape was linking to a macro
        If MacroLink <> vbNullString And InStr(MacroLink, "!") <> 0 Then
            'Split Macro Link at the exclaimation mark (store in Array)
            SplitLink = Split(MacroLink, "!")

            'Pull text occurring after exclaimation mark
            NewLink = SplitLink(1)

            'Remove any straggling apostrophes from workbook name
            If Right(NewLink, 1) = "'" Then
                NewLink = Left(NewLink, Len(NewLink) - 1)
            End If

            'Apply New Link
            control.OnAction = NewLink
        End If
    Next control
End Sub

 

[musicfreer]

I found this

Public Sub FixCopiedButtonMacroLinks(ByVal theSheet As Worksheet)
    ' UPDATED: by HackSlash to accept a worksheet parameter.
    'PURPOSE: Remove an external workbook reference from all shapes triggering macros
    'Source: www.TheSpreadsheetGuru.com

    Dim control As Shape
    Dim MacroLink As String
    Dim SplitLink As Variant
    Dim NewLink As String

    'Loop through each shape in worksheet
    For Each control In theSheet.Shapes

        'Grab current macro link (if available)
        MacroLink = control.OnAction

        'Determine if shape was linking to a macro
        If MacroLink <> vbNullString And InStr(MacroLink, "!") <> 0 Then
            'Split Macro Link at the exclaimation mark (store in Array)
            SplitLink = Split(MacroLink, "!")

            'Pull text occurring after exclaimation mark
            NewLink = SplitLink(1)

            'Remove any straggling apostrophes from workbook name
            If Right(NewLink, 1) = "'" Then
                NewLink = Left(NewLink, Len(NewLink) - 1)
            End If

            'Apply New Link
            control.OnAction = NewLink
        End If
    Next control
End Sub

Thanks for your reply.

Sorry that I am really new to coding. How should I use these codes?