CODEWITHSUNDEEP
excelvbaexcel-formula
ccornell
ccornell

Reputation: 15

Copying cells from multiple files in one folder

I have a folder that has more than 100 Excel workbooks.

On all of these sheets I need to consolidate two cells of data from each file into one master sheet.

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 code, nothing happens.

Upvotes: 0

Views: 432

Answers (2)

zsalya
zsalya

Reputation: 454

If the target sheetnames are static, is there any need to use VBA? External links are dangerous, but no more so that reading by VBA.

In a new file you can put: ='[File_01.xlsx]sheetname'!$C$24 etc You need the path in order to use this without opening the target files. To generate those formulae you can have cells containing the path, the filename, and the sheetname. (If filenames are sequential numbers, just drag down from the first) If you name the cells you can do =Concatenate(path,file,sheet) Or if not then something like =CONCATENATE(,B4,B5,"'!",B6) INDIRECT only works with target files open, so at some stage you need to Copy and Paste Value the paths, and put = at the front.

Upvotes: 0

FaneDuru
FaneDuru

Reputation: 42236

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

Upvotes: 2

Related Questions