Copy data from Master File and Paste to their Respective file

[abc_xyz]

I have a source file from where I want to extract data and paste them to their respective destination file. Criteria is country names present in Column E - Row12 (Headers in Row11), in Column F I have the destination file path and name where I want the code to paste data.

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

Problem: the below code seems to paste the entire data set. The source data set is massive, hence using Scripting Dictionary.
Can anyone please help?

Asked here: Copy data from Master File and Paste to their Respective file

Sub dict_test()

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

Set Dict = CreateObject("scripting.dictionary")
MyRng = ThisWorkbook.Sheets("Dashboard").Range("E12:E" & Cells(Rows.Count, "E").End(xlUp).Row).Value



SourceFilePath = ThisWorkbook.Sheets("Dashboard").Range("F3")
SourceSheet = ThisWorkbook.Sheets("Dashboard").Range("G3")


Set OpenSource = Workbooks.Open(SourceFilePath)



With ThisWorkbook.Sheets("Dashboard")
  
        For Each cl In .Range("E12", .Range("E" & Rows.Count).End(xlUp))
            
            Dict(cl.Value) = cl.Offset(, 1).Value
              
        Next cl
        
End With


For Each ikey In Dict.keys
    
    CountryName = ikey
    DestinationFilePath = Dict(ikey)
    
    
    Set OpenDestination = Workbooks.Open(DestinationFilePath)
    
    
    With OpenSource.Sheets(SourceSheet)

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

    End With
    
    
    With OpenDestination.Sheets(SourceSheet)
        .Range("A2").PasteSpecial
    End With
    


    Set OpenDestination = Nothing


Next




End Sub

 

[Fluff]

Duplicate to: Extract data using Scripting Dictionary

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread. If you do not receive a response, you can "bump" it by replying to it yourself, though we advise you to wait 24 hours before doing so, and not to bump a thread more than once a day.