Open file copy and paste when value changes

[rholdren]

Excel 365 - I have a worksheet that has a list of file names (entire path) 5 columns of data ( C-G) that follows the file name. I can have excel copy the data in columns C-G on copy one by one down the list but what I was looking for is a shortcut. Instead of having Excel copy the line of data in row two then open the file, paste, save and close the file. Then return to row 3 copy the data open the file location, copy paste save and close (what could be the exact same file - or not) and continue to repeat this process until it reaches the bottom of the list. In the example below Donald Duck has two rows, below him Daisy has eight rows. Rather than have each of the file opened and closed multiple time to to copy and paste ranges I was trying to find a shortcut to open each file once. I get a similar file on a monthly basis and I do it manually each month. Any Thoughts?

2242760	C:\PersonalReviews\Donald Duck.xls	202207	119	21	38	44
2242760	C:\PersonalReviews\Donald Duck.xls	202208	117	21	38	43
2240553	C:\PersonalReviews\Daisy Duck.xls	202201	144	10	15	15
2240553	C:\PersonalReviews\Daisy Duck.xls	202202	139	10	15	13
2240553	C:\PersonalReviews\Daisy Duck.xls	202203	133	11	15	12
2240553	C:\PersonalReviews\Daisy Duck.xls	202204	134	11	15	13
2240553	C:\PersonalReviews\Daisy Duck.xls	202205	134	12	15	13
2240553	C:\PersonalReviews\Daisy Duck.xls	202206	136	11	15	14
2240553	C:\PersonalReviews\Daisy Duck.xls	202207	134	11	13	13
2240553	C:\PersonalReviews\Daisy Duck.xls	202208	134	12	13	13
2139208	C:\PersonalReviews\Mickey Mouse.xls	202108	58	19	16	37
2139208	C:\PersonalReviews\Mickey Mouse.xls	202109	56	18	16	35
2139208	C:\PersonalReviews\Mickey Mouse.xls	202110	60	17	15	34
2139208	C:\PersonalReviews\Mickey Mouse.xls	202111	56	16	13	35
2139208	C:\PersonalReviews\Mickey Mouse.xls	202112	58	17	11	36

Any help would be greatly appreciated.

Thanks

 

[Alex Blakenburg]

You will need to tweak it a little but something like this should do it.

Sub OpenWorkbookInListAndPasteData()
    Dim srcWB As Workbook, destWB As Workbook
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim oDict As Object
    Dim srcRng As Range, rngTemp As Range
    Dim iRow As Long
    Dim vKey As Variant
    Dim sKey As String
    
    Set srcWB = ThisWorkbook
    Set srcSht = ActiveSheet    ' <--- Leave as activesheet or specify sheet name
'    Set destWB = ThisWorkbook
'    Set destSht = destWB.Worksheets("PasteData")
    
    'create late bound dictionary object
    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.comparemode = vbTextCompare
    
    'the data to add
    Set srcRng = srcSht.Cells(1, 1).CurrentRegion
    'skip header row
    For iRow = 2 To srcRng.Rows.Count
        
        'save the key value - which is the file name to open
        sKey = CStr(srcSht.Cells(iRow, 2).Value)
        
        'if the key is already in the dictionary, then Union the other row with the same key
        With srcRng
            If oDict.exists(sKey) Then
                Set rngTemp = oDict(sKey)
                Set rngTemp = Union(rngTemp, .Range(.Cells(iRow, 3), .Cells(iRow, 7)))
                Set oDict(sKey) = rngTemp
            'otherwise just add the key and row
            Else
                Set rngTemp = .Range(.Cells(iRow, 3), .Cells(iRow, 7))
                Set oDict(sKey) = rngTemp
            End If
        End With
    Next iRow
    
    'loop through the dictionary keys & paste
    For Each vKey In oDict.keys
        Set destWB = Workbooks.Open(vKey)
        Set destSht = destWB.Worksheets(1)          ' <--- Specify sheet to use in paste
        Set rngTemp = oDict(vKey)
        rngTemp.Copy Destination:=destSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next vKey
    Set oDict = Nothing
End Sub

 

[rholdren]

You will need to tweak it a little but something like this should do it.

Sub OpenWorkbookInListAndPasteData()
    Dim srcWB As Workbook, destWB As Workbook
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim oDict As Object
    Dim srcRng As Range, rngTemp As Range
    Dim iRow As Long
    Dim vKey As Variant
    Dim sKey As String
   
    Set srcWB = ThisWorkbook
    Set srcSht = ActiveSheet    ' <--- Leave as activesheet or specify sheet name
'    Set destWB = ThisWorkbook
'    Set destSht = destWB.Worksheets("PasteData")
   
    'create late bound dictionary object
    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.comparemode = vbTextCompare
   
    'the data to add
    Set srcRng = srcSht.Cells(1, 1).CurrentRegion
    'skip header row
    For iRow = 2 To srcRng.Rows.Count
       
        'save the key value - which is the file name to open
        sKey = CStr(srcSht.Cells(iRow, 2).Value)
       
        'if the key is already in the dictionary, then Union the other row with the same key
        With srcRng
            If oDict.exists(sKey) Then
                Set rngTemp = oDict(sKey)
                Set rngTemp = Union(rngTemp, .Range(.Cells(iRow, 3), .Cells(iRow, 7)))
                Set oDict(sKey) = rngTemp
            'otherwise just add the key and row
            Else
                Set rngTemp = .Range(.Cells(iRow, 3), .Cells(iRow, 7))
                Set oDict(sKey) = rngTemp
            End If
        End With
    Next iRow
   
    'loop through the dictionary keys & paste
    For Each vKey In oDict.keys
        Set destWB = Workbooks.Open(vKey)
        Set destSht = destWB.Worksheets(1)          ' <--- Specify sheet to use in paste
        Set rngTemp = oDict(vKey)
        rngTemp.Copy Destination:=destSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next vKey
    Set oDict = Nothing
End Sub

Thanks. I'm about to give this a shot.

 

[rholdren]

It should be pasting on sheet2 starting in cell J27 but it's not pasting
I probably did not change that correctly. I changed the following:
Set destSht = destWB.Worksheets("Sheet2") ' <--- Specify sheet to use in paste
Set rngTemp = oDict(vKey)
rngTemp.Copy Destination:=destSht.Range("J" & Rows.Count).End(xlUp).Offset(9, 27)

 

[Alex Blakenburg]

So for every workbook in the list you want to paste it to a sheet called "Sheet2" and you want all the rows to paste to J27 is that correct ?
If so the Destination should be:
destSht.Range("J27")

rngTemp.Copy Destination:=destSht.Range("J27")

 

[rholdren]

Thank you Alex it worked perfectly . I really appreciate it.

Consider this one closed.

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.