Copying data from a variable workbook

[Raghuveer20]

Copying data from a variable workbook

Hi all!

I want to achieve the below, i.e. copy only GDP data into a new sheet. I have written a code for it but it isn’t working. I wrote it reading some sources on net but wasn't successful. Can anyone please help?
Further, please note that the keyword GDP always doesn’t occur in the same position and there can be “n” number of keywords (like BOP, PCI, GDP, NI….n number) in random order.

BEFORE RUNNING CODE

WORKBOOK-1 (countrydata.xlsx) SHEETNAME(gdppcibop)

2014 2015 2016
Britain
GDP 4 4.2 4.5
PCI 7000 7200 7400
BOP 10 12 14

France
PCI 6000 6500 6700
GDP 3.8 4.0 4.1

Spain
BOP 7 7.2 7.4
PCI 5000 5500 5700
NI 2500 2800 3000
GDP 2.1 2.2 2.3

WORKBOOK-2 (onlygdpdata.xlsm) SHEETNAME(gdp)
2014 2015 2016
Britain
France
Spain

AFTER RUNNING CODE - IT SHOULD LOOK LIKE BELOW

WORKBOOK-2 (onlygdpdata.xlsm) SHEETNAME(gdp)
2014 2015 2016
Britain 4 4.2 4.5
France 3.8 4.0 4.1
Spain 2.1 2.2 2.3



Sub GDPSheet()
PathName = ActiveWorkbook.Path
File1 = "countrydata.xlsx"
File2 = "onlygdpdata.xlsm"
Workbooks.Open Filename:=PathName & "\" & File1
Workbooks.Open Filename:=PathName & "\" & File2
Set wb1 = Workbooks(File1)
Set wb2 = Workbooks(File2)
Set sh1 = wb1.Sheets("gdppcibop")
Set sh2 = wb2.Sheets("gdp")

''Application.ScreenUpdating = False

lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
For Each c In rng
Set fLoc = sh2.Range("A:A").Find(c.Value, , xlValues) ‘’find country name
If Not fLoc Is Nothing Then

“The below for loop was written to find gdp name in the rows after the country name. However, I have no idea of how to continue search till GDP keyword is found and stop searching after. I have used a counter till 10 as example
”

For counter = 1 To 10
Set gLoc = c.Offset(counter, 0).Find("GDP", , xlValues)
If Not gLoc Is Nothing Then
gLoc.Offset(counter, 0).Resize(1, 3).Copy
fLoc.Offset(0, 1) .PasteSpecial Paste:=xlPasteValues ‘’paste data
counter = 11 ‘’made it 11 to exit this inner for loop
End If
Next
End If
Next

Workbooks(File1).Activate
ActiveWorkbook.Close
Workbooks(File2).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub