VBA to extract Rows from several sheets

[irishr_ram]

Hi All,

I have a requirement to extract several rows from different spreadsheet files.

I can with the below code extract a row from each as it just loops through the files but cannot figure how to get it to loop through each spreadsheet on the required tab until the end of the rows and then move onto the next file. Also once I get it to do that I want to be able to incorporate that each set of rows from each sheet is pasted below each other combined.

Any help appreciated

rowTarget = 3
rowSource = 5


Set wsCostCentreView = Sheets("Cost Centre View")


Folderpath = "C:\Users\fxd38\Desktop\Data"
Filename = Dir(Folderpath & "*.xls*")


Do While Filename <> ""


       'open the source file and set the source worksheet
      Set wbSource = Workbooks.Open(Folderpath & Filename, ReadOnly:=True, UpdateLinks:=False)
      
      On Error Resume Next
      Set wsForecastHourly = wbSource.Worksheets("Forecast - Hourly")
      Set wsForecastAC = wbSource.Worksheets("Forecast - Additional Costs")
      Set wsInfo = wbSource.Worksheets("Info")
      
      Application.StatusBar = "Updating" & " " & wsInfo.Range("B2").Value & " " & "Financials"
      
      'wsForecastHourly.Range("B5", Range("B" & row.Count).End(xlUp)).Copy
      'wsCostCentreView.Range("C3").End(xlUp)(2).PasteSpecial xlPasteValues
      
      
   wsCostCentreView.Range("C" & rowTarget).Value = wsForecastHourly.Range("B" & rowSource).Value
   wsCostCentreView.Range("D" & rowTarget).Value = wsForecastHourly.Range("C" & rowSource).Value
   'wsCostCentreView.Range("E" & rowTarget).Value = wsForecastAC.Range("A4").Value
   wsCostCentreView.Range("F" & rowTarget).Value = wsForecastHourly.Range("A" & rowSource).Value
   'wsCostCentreView.Range("G" & rowTarget).Value = wsForecastAC.Range("B4").Value
   wsCostCentreView.Range("H" & rowTarget).Value = wsForecastHourly.Range("D" & rowSource).Value


'ActiveCell.Offset(1, 0).Select


'row = row + 1


'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
rowSource = rowSource + 1
Filename = Dir()


Loop

 

[irishr_ram]

Can anyone provide any help here, thanks

 

[Sohail01]

Hi , sorry I can't prvide help but perhaps you can help me as I need a similar code as you've already got! I need to extract data from 30 plus difference files if the value in column B of the source files is the same as the one I require. Is this what your code does at present please? thanks,

 

[irishr_ram]

Hi , sorry I can't prvide help but perhaps you can help me as I need a similar code as you've already got! I need to extract data from 30 plus difference files if the value in column B of the source files is the same as the one I require. Is this what your code does at present please? thanks,

No all my code does above is access all xls* files in a specific folder and extract the column I have specified. You would want something like this but then with some sort of lookup

 

[irishr_ram]

Still looking for some help on this chaps.

I have got a bit further in that I have inserted some code which now lets me pull all the data back from non blank rows however when I get it to loop through 2 workbooks, the data from the 2nd workbook just overwrites the 1st set of data.

Any help appreciated.

Code below

rowTarget = 3
rowSource = 6


Set wsCostCentreView = Sheets("Cost Centre View")


Folderpath = "H:\Budget Tracker\Data"
Filename = Dir(Folderpath & "*.xls*")


Do Until Filename = ""


'open the source file and set the source worksheet
Set wbSource = Workbooks.Open(Folderpath & Filename, ReadOnly:=True, UpdateLinks:=False)

On Error Resume Next
Set wsForecastHourly = wbSource.Worksheets("Forecast - Hourly")
Set wsForecastAC = wbSource.Worksheets("Forecast - Additional Costs")
Set wsInfo = wbSource.Worksheets("Info")

Application.StatusBar = "Updating" & " " & wsInfo.Range("B2").Value & " " & "Financials"

'wsForecastHourly.Range("B5", Range("B" & row.Count).End(xlUp)).Copy
'wsCostCentreView.Range("C3").End(xlUp)(2).PasteSpecial xlPasteValues

'NumRows = wsForecastHourly.Range("A6", Range("A6").End(xlDown)).rows.Count
Rows = wsForecastHourly.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

For x = 1 To Rows
wsCostCentreView.Range("I" & rowTarget).Value = rowTarget
wsCostCentreView.Range("C" & rowTarget).Value = wsForecastHourly.Range("B" & rowSource).Value
wsCostCentreView.Range("D" & rowTarget).Value = wsForecastHourly.Range("C" & rowSource).Value
'wsCostCentreView.Range("E" & rowTarget).Value = wsForecastAC.Range("A4").Value
wsCostCentreView.Range("F" & rowTarget).Value = wsForecastHourly.Range("A" & rowSource).Value
'wsCostCentreView.Range("G" & rowTarget).Value = wsForecastAC.Range("B4").Value
wsCostCentreView.Range("H" & rowTarget).Value = wsForecastHourly.Range("D" & rowSource).Value
ActiveCell.Offset(1, 0).Select




rowTarget = rowTarget + 1
rowSource = rowSource + 1
Filename = Dir()


Next




'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False


'row = row + 1


Loop