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

SereneSea

New Member
Joined
Feb 2, 2022
Messages
43
Office Version
  1. 2016
Platform
  1. Windows
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!

VBA Code:
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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

shknbk2

Well-known Member
Joined
Mar 5, 2016
Messages
571
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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
 
Solution

SereneSea

New Member
Joined
Feb 2, 2022
Messages
43
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Mar 5, 2016
Messages
571
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Feb 2, 2022
Messages
43
Office Version
  1. 2016
Platform
  1. Windows
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

VBA Code:
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

New Member
Joined
Feb 2, 2022
Messages
43
Office Version
  1. 2016
Platform
  1. Windows
I meant 5 columns to the right Oops, but yes E2 would be the goal
 

shknbk2

Well-known Member
Joined
Mar 5, 2016
Messages
571
Office Version
  1. 365
Platform
  1. Windows
Change the Select line and the Lastrowa line:
VBA Code:
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

New Member
Joined
Feb 2, 2022
Messages
43
Office Version
  1. 2016
Platform
  1. Windows
WOW! Thank you so much for all your help and your prompt reply!!!!! You have no idea how much this helps!
 

shknbk2

Well-known Member
Joined
Mar 5, 2016
Messages
571
Office Version
  1. 365
Platform
  1. Windows
It's a pleasure to help.
 

Forum statistics

Threads
1,181,454
Messages
5,930,003
Members
436,716
Latest member
MiroUna

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top