• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy data from Master File and Paste to their Respective file


New Member
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 EColumn F
CountryFile path

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?

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)
    End With

    Set OpenDestination = Nothing


End Sub

Marc L

Excel Ninja
Can anyone please help?
Attach at least the source workbook …​
The data must be appended to existing destination workbooks - in this case attach too both destination workbooks - or​
a new workbook by country should be created ?​