Copying cells from multiple files in 1 folder-CodePudding

I currently have a folder that has many (>100) excel workbooks in. on all of these sheets I only need 2 specific cells of data and need to consolidate these into 1 master sheet. I am currently trying to create a VBA scrip that will allow me to copy these 2 certain cells from each file however am getting some issues along the way.

I currently have the following script:

Sub Macro()


Dim StrFile As String

Dim TargetWb As Workbook

Dim SourceWb As Workbook

Dim i As Integer

Set TargetWb = Workbooks("Practice.xlsm")

i = 2

StrFile = Dir("\\W.X.com\Y\OPERATIONS\Performance-Reporting\SharedDocuments\Regulatory\Z\X")


Do While Len(StrFile) > 0

Set SourceWb = Workbooks.Open(StrFile)

TargetWb.Sheets("Sheet1").Range("A" & i).Value = SourceWb.Sheets("SCR").cell("C24").Value
TargetWb.Sheets("Sheet1").Range("B" & i).Value = SourceWb.Sheets("SCR").cell("B3").Value

SourceWb.Close SaveChanges:=False

i = i   1

Loop


End Sub

When i run this script, absolutely nothing happens. I am not to sure why this is the case, would anyone please be able to help?

I am relatively new to VBA so if its a glaringly obvious fix I do apologise.

Thanks in advance!

CodePudding user response：

Since, only two cells value is needed to be return, this can be done without opening the workbook, using ExecuteExcel4Macro. Please, test the next code and send some feedback:

Sub Macro()
 Dim StrFile As String, TargetWb As Workbook, ws As Worksheet, i As Long, StrFormula As String
 Const strPath As String = "\\W.X.com\Y\OPERATIONS\Performance-Reporting\SharedDocuments\Regulatory\Z\X\" 'take care of the ending backslash

 Set TargetWb = Workbooks("Practice.xlsm")
 Set ws = TargetWb.Sheets("Sheet1")
 i = 2

 StrFile = Dir(strPath & "*.xls*") 'it returns all files having extensions as xls, xlsx, xlsm, xlsa, xlsb
 Dim sheetName As String: sheetName = "SCR"
 Do While Len(StrFile) > 0
     StrFormula = "'" & strPath & "[" & StrFile & "]" & sheetName 
     ws.Range("A" & i).value = Application.ExecuteExcel4Macro(StrFormula & "'!R24C3")
     ws.Range("B" & i).value = Application.ExecuteExcel4Macro(StrFormula & "'!R3C2")
    
    i = i   1
    StrFile = Dir() 'needed to continue the iteration up to the last file
 Loop
End Sub