I am trying to extract data from Source file and paste it into their respective template file.
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
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
VBA Code:
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