• 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

    Hui...

  • 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

hsm123

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
BrazilC:\Users\ABC123\Desktop\Brazil.xlsx
USAC:\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?

Code:
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
 
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 ?​
 
Back
Top