Create a loop for a copy paste task

[snowcrash]

Hi All,

I have created the below macro using macro recorder, and need some help to loop the task until now more links in column C.

Task:
Open up a workbook via a hyperlink in column "C" on a master file, in the newly opened workbook copy a row of data in a hidden sheet and paste this data into the master file on the same row as the hyperlink, then close the file. and repeat this for the next hyperlink in the column until no more hyperlinks

	C	D	E	F	G
4	hyperlink1.xlsm	copied data	copied data	copied data	copied data
5	hyperlink2.xlsm
6	hyperlink2.xlsm

<tbody>
</tbody>

using macro recorder


Sub Consolidation()


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Windows("Masterfile.xlsm").Activate
Range("C4").Hyperlinks(1).Follow


Windows("hyperlink1.xlsm").Visible = True
Sheets("hiddensheet").Visible = True
Sheets("hiddensheet").Select
Range("B4:E4").Select
Selection.Copy
Windows("Masterfile.xlsm").Activate
Range("D4").Select
ActiveSheet.Paste
Windows("hyperlink1.xlsm").Activate
Sheets("hiddensheet").Select
ActiveWindow.SelectedSheets.Visible = False
ActiveWindow.Close savechanges:=False

Windows("Masterfile.xlsm").Activate


Application.DisplayAlerts = False
Application.ScreenUpdating = True

End Sub

 

[tonyyy]

Re: Help to create a loop for a copy paste task

snowcrash,

You might consider the following...

Sub Consolidation()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim LastRow As Long
Dim r As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb1 = Workbooks("Mastefile.xlsm")
Set ws = wb1.Sheets(1)
LastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
For Each r In ws.Range("C4:C" & LastRow)
    r.Hyperlinks(1).Follow
    Set wb2 = ActiveWorkbook
    ws.Range(ws.Cells(r.Row, 4), ws.Cells(r.Row, 7)).Value = wb2.Sheets("hiddensheet").Range("B4:E4").Value
    wb2.Close savechanges:=False
Next r

Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub

Please note, the code is untested.

Cheers,

tonyyy

 

[snowcrash]

Re: Help to create a loop for a copy paste task

Thank you tony, works great.

I still have one complication.
The "DisplayAlerts = false" does not prevent the microsoft prompt "some files can contain viruses.................. Would you like to open this file?"

I have tired adding the site to trusted locations, searching to change the trust settings some are restricted to me on this computer. and i can't bypass it, meaning instead of letting the macro run, i would have to click during each loop when the prompt comes up. Is there another way to bypass this, or a code that would select ok when the prompt appears?

 

[tonyyy]

Re: Help to create a loop for a copy paste task

Sorry, if the "DisplayAlerts = False" doesn't prevent the prompt and you can't add the site as a trusted location, I don't know of a way to bypass the security prompt.

You could consider another approach, one that doesn't open the files at all...

Sub Consolidation2()
Dim wb1 As Workbook, ws As Worksheet
Dim LastRow As Long
Dim r As Range
Dim fPath As String, fName As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb1 = Workbooks("Mastefile.xlsm")
Set ws = wb1.Sheets(1)
LastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
fPath = "C:\Docs 2018\2018 Gigs\MrExcel" & "\" 'Change to your folder path

For Each r In ws.Range("C4:C" & LastRow)
    fName = "[" & r.Hyperlinks(1).TextToDisplay & "]"
    With ws.Range(Cells(r.Row, 4), Cells(r.Row, 7))
        .Formula = "='" & fPath & fName & "hiddensheet'!B4:E4"
        .Value = .Value
    End With
Next r

Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub

Be sure to change the file path.

It's assumed the hyperlink text is the actual file name.

Cheers,

tonyyy