VBA Copy and Paste link from a range in multiple sheets into a Master Sheet

[SereneSea]

Good morning

I am new to VBA and I am using this code from a previous thread, but instead of pasting values I would like to paste links. How can I add this in the code? I tried replacing Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues with Sheets("Summary").Cells(Lastrowa).Paste Link:=True , but it no longer pastes from all the sheets, just the last sheet. I have 52 sheets so this code will help me tremendously.

Thank you in advance!

Sub Copy_Range_From_Sheets()
'Modified  10/12/2021  6:36:48 PM  EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 6

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
    
    With Sheets(ans)
        .Range("A123:T215").Copy
        Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "You tried to use a sheet name that does not exist" & vbNewLine & "Or we had another problem"
Application.ScreenUpdating = True
End Sub

 

[shknbk2]

How about this? It changes the PasteSpecial line into 2: select the Lastrowa cell and the use ActiveSheet.Paste Link:=True.

When I try it with random data, the links seem to paste from all pages.

Sub Copy_Range_From_Sheets()
'Modified  10/12/2021  6:36:48 PM  EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 6

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
    
    With Sheets(ans)
        .Range("A123:T215").Copy
        Sheets("Summary").Cells(Lastrowa, 1).Select
        ActiveSheet.Paste Link:=True
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "You tried to use a sheet name that does not exist" & vbNewLine & "Or we had another problem"
Application.ScreenUpdating = True
End Sub

 

[SereneSea]

Oh my goodness! Thank you so MUCH!!! It worked perfectly!! , I missed the .Select.

If you don't mind me asking, what does the .select do?

 

[shknbk2]

Literally, it sets the Application selection to that cell (as if you were to click on it with your mouse). I couldn't remember the specifics for pasting as a link, so I recorded a macro doing so and checked out the code, which indicated the ActiveSheet.Paste solution. In order to be on the ActiveSheet, you need to select it (and the paste destination).

 

[SereneSea]

Great to know. And sorry for bothering you but which part of the line would I change to have it paste starting on E2? Every change I am making seems to break the code.
I was able to make it paste in row 2 but I do no know how to add to paste 5 columns to the left

Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 2

 

[SereneSea]

I meant 5 columns to the right Oops, but yes E2 would be the goal

 

[shknbk2]

Change the Select line and the Lastrowa line:

Sub Copy_Range_From_Sheets()
'Modified  10/12/2021  6:36:48 PM  EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 2

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
    
    With Sheets(ans)
        .Range("A123:T215").Copy
        Sheets("Summary").Cells(Lastrowa, 5).Select
        ActiveSheet.Paste Link:=True
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "E").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "You tried to use a sheet name that does not exist" & vbNewLine & "Or we had another problem"
Application.ScreenUpdating = True
End Sub

 

[SereneSea]

WOW! Thank you so much for all your help and your prompt reply!!!!! You have no idea how much this helps!

 

[shknbk2]

It's a pleasure to help.