Extract data using Scripting Dictionary

[abc_xyz]

I am trying to extract data from Source file and paste it into their respective template file.

Column E	Column F
Country	File path
Brazil	C:\Users\ABC123\Desktop\Brazil.xlsx
USA	C:\Users\ABC123\Desktop\USA.xlsx

Requirement: Copy rows from the source file which has the same country from Column E and paste the entire row in the file path provided in the next cell.

The code seems to paste entire data set for the listed countries. It should paste Brazil's data into brazils file and so on. Can someone please help?

Also asked here Copy data from Master File and Paste to their Respective file

Sub test1()


Dim SourceFilePath, SourceSheet, CountryName, DestinationFilePath, NewSheetName, File_Name As String
Dim OpenSource, OpenDestination As Workbook
Dim cl As Range, Rng As Range
Dim Dic As Object
Dim StartTime As Double
Dim MinutesElapsed As String
Dim i, lastrow As Long




With Application
   .ScreenUpdating = True
   .DisplayAlerts = False
   .EnableEvents = False
End With



lastrow = ThisWorkbook.Sheets("Dashboard").Range("E" & Rows.Count).End(xlUp).Row
SourceFilePath = ThisWorkbook.Sheets("Dashboard").Range("F3")
SourceSheet = ThisWorkbook.Sheets("Dashboard").Range("G3")


Set Dic = CreateObject("scripting.dictionary")
   
'Add Key words to dictionary
    With ThisWorkbook.Sheets("Dashboard")
  
        For Each cl In .Range("E12", .Range("E" & Rows.Count).End(xlUp))
           
            Dic(cl.Value) = cl.Value
       
        Next cl
       
    End With




Set OpenSource = Workbooks.Open(SourceFilePath)




'Loop through each Key in the Dictionary
For Each Key In Dic.keys

    For i = 12 To lastrow


DestinationFilePath = ThisWorkbook.Sheets("Dashboard").Cells(i, 6)
NewSheetName = ThisWorkbook.Sheets("Dashboard").Cells(i, 7)
File_Name = ThisWorkbook.Sheets("Dashboard").Cells(i, 8)

Set OpenDestination = Workbooks.Open(DestinationFilePath)

        With OpenSource.Sheets(SourceSheet)

                For Each cl In .Range("V2", .Range("V" & Rows.Count).End(xlUp))
           
                    If Dic.Exists(cl.Value) Then
                        If Rng Is Nothing Then Set Rng = cl Else Set Rng = Union(Rng, cl)
                    End If
       
                Next cl
           
                    If Not Rng Is Nothing Then Rng.EntireRow.Copy

        End With


        With OpenDestination.Sheets(SourceSheet)
            .Range("A2").PasteSpecial Paste:=xlPasteValues
        End With


    Next i

Next Key





With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
   .EnableEvents = True
End With




End Sub

 

[Dan_W]

Well my comments on the last code apply here too, but now I'm even more confused - What is this storing in the dictionary?

Dict(cl.Value) = cl.Offset(, 1).Value

This is teh code you had on the other website, no?