Pull data from closed workbooks in same folder

[ceytl]

Hello,

I have been looking for VBA script that can go into all the closed .xlsx files in a folder called S1 and grab the data from cells B5, H7, F19, F20, F21, and then put these values in A2, B2, C2, D2, E2

There is about 100 files, and the path is: c:\Users\US\Desktop\S1

is this something that can be done?

Thanks,

 

[Excel Sheet Pro]

First, the caveat: You can read data from a closed workbook, but you cannot write data to a closed workbook. Workbooks have to be opened for data to change. So if you don't mind that workbooks are automatically opened, processed, saved, and closed in sequence, there should be no problem to the operation. NOTE: the workbooks may be opened with no visibility so you won't see the applications flashing on and off. (NOTE: I am 99.9% sure one cannot write to a closed workbook, but there may be that 0.1% obscure super-duper API-level method that could make it do it; having said that, I doubt it could be done because if it could, some enterprising scriptwriter would most probably have made a wrapper for the function in the first place; none exists as far as I know.)

However you didn't indicate a sheet name, just cell ranges. I can make an assumption that all the target sheet names in every excel file is either named the same, or alternatively, is the first sheet in the tab sequence in each file. Otherwise you would have to do a laborious search process to indicate that the source cells are, indeed, of the data you are looking for in the fist place before processing.

I'm currently at work so not in a place where I can easily write a code snippet, but if you make use of the file system object (or more crudely, the DIR function), you should be able to achieve the above. There are several threads on VBA that open/close a workbook in this forum, start at those.

 

[tonyyy]

Here's an implementation utilizing the crude DIR function.

Sub LoopThroughFiles()
Dim wb As Workbook
Dim directory As String, fileName As String

Application.ScreenUpdating = False
directory = "c:\Users\US\Desktop\S1\"
fileName = Dir(directory & "*.xlsx")

Do While fileName <> ""
    Set wb = Workbooks.Open(directory & fileName)
        With wb.Sheets(1) 'Change to your sheet name or number
            .Range("A2") = .Range("B5")
            .Range("B2") = .Range("H7")
            .Range("C2") = .Range("F19")
            .Range("D2") = .Range("F20")
            .Range("E2") = .Range("F21")
        End With
    wb.Close savechanges:=True
    fileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

 

[ceytl]

Here's an implementation utilizing the crude DIR function.

Sub LoopThroughFiles()
Dim wb As Workbook
Dim directory As String, fileName As String

Application.ScreenUpdating = False
directory = "c:\Users\US\Desktop\S1\"
fileName = Dir(directory & "*.xlsx")

Do While fileName <> ""
    Set wb = Workbooks.Open(directory & fileName)
        With wb.Sheets(1) 'Change to your sheet name or number
            .Range("A2") = .Range("B5")
            .Range("B2") = .Range("H7")
            .Range("C2") = .Range("F19")
            .Range("D2") = .Range("F20")
            .Range("E2") = .Range("F21")
        End With
    wb.Close savechanges:=True
    fileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

I'm not sure I explained it very well, but I want to open an excel spreadsheet run the VBA script to go into the S1 folder and go through each .xlsx file and copy the information back to my opened sheet. In the S1 folder the workbook sheet names are all the same, named: D1, but every workbook has a different name. When I run the above script it saves all the info in each .xlsx file.

Thanks for your help so far!

 

[tonyyy]

"I'm not sure I explained it very well..." -- Ya, it helps if you can be precise about what you ask for.

Sub LoopThroughFiles()
Dim wb1 As Workbook, wb2 As Workbook
Dim directory As String, fileName As String

Application.ScreenUpdating = False
directory = "c:\Users\US\Desktop\S1\"
fileName = Dir(directory & "*.xlsx")
Set wb1 = ThisWorkbook

Do While fileName <> ""
    Set wb2 = Workbooks.Open(directory & fileName)
        With wb2.Sheets("D1")
            wb1.Sheets(1).Range("A2") = .Range("B5")
            wb1.Sheets(1).Range("B2") = .Range("H7")
            wb1.Sheets(1).Range("C2") = .Range("F19")
            wb1.Sheets(1).Range("D2") = .Range("F20")
            wb1.Sheets(1).Range("E2") = .Range("F21")
        End With
    wb.Close savechanges:=True
    fileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

Of course, you're gonna end up with data in just the second row... which is what you asked for. If you want data to append to the next blank line you'll have to adjust the code for that.

 

[johnnyL]

@tonyyy, Your code is still not correct. Your code will just keep overwriting A2:E2.

 

[ceytl]

"I'm not sure I explained it very well..." -- Ya, it helps if you can be precise about what you ask for.

Sub LoopThroughFiles()
Dim wb1 As Workbook, wb2 As Workbook
Dim directory As String, fileName As String

Application.ScreenUpdating = False
directory = "c:\Users\US\Desktop\S1\"
fileName = Dir(directory & "*.xlsx")
Set wb1 = ThisWorkbook

Do While fileName <> ""
    Set wb2 = Workbooks.Open(directory & fileName)
        With wb2.Sheets("D1")
            wb1.Sheets(1).Range("A2") = .Range("B5")
            wb1.Sheets(1).Range("B2") = .Range("H7")
            wb1.Sheets(1).Range("C2") = .Range("F19")
            wb1.Sheets(1).Range("D2") = .Range("F20")
            wb1.Sheets(1).Range("E2") = .Range("F21")
        End With
    wb.Close savechanges:=True
    fileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

Of course, you're gonna end up with data in just the second row... which is what you asked for. If you want data to append to the next blank line you'll have to adjust the code for that.

Thanks for you help!

I got it to work part way, but it gets stuck here: wb.Close savechanges:=True
It leaves the first file open, and stop there. Any ideas?

 

[johnnyL]

Thanks for you help!

I got it to work part way, but it gets stuck here: wb.Close savechanges:=True
It leaves the first file open, and stop there. Any ideas?

change wb to wb2 in that line.

 

[tonyyy]

@tonyyy, Your code is still not correct. Your code will just keep overwriting A2:E2.

It's correct for what the op asked for... which is the reason I added the comment "If you want data to append to the next blank line you'll have to adjust the code for that."

 

[tonyyy]

change wb to wb2 in that line.

Thanks, johhnyL.