Pull data from closed workbooks in same folder

ceytl

Board Regular
Joined
Jun 6, 2009
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
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 Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Excel Sheet Pro

New Member
Joined
Jun 10, 2015
Messages
5
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

Well-known Member
Joined
Jun 24, 2015
Messages
1,771
Office Version
  1. 2010
Platform
  1. Windows
Here's an implementation utilizing the crude DIR function. ;)

VBA Code:
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

Board Regular
Joined
Jun 6, 2009
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
Here's an implementation utilizing the crude DIR function. ;)

VBA Code:
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

Well-known Member
Joined
Jun 24, 2015
Messages
1,771
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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

VBA Code:
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

Well-known Member
Joined
Nov 7, 2011
Messages
2,096
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@tonyyy, Your code is still not correct. Your code will just keep overwriting A2:E2. ;)
 

ceytl

Board Regular
Joined
Jun 6, 2009
Messages
114
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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

VBA Code:
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

Well-known Member
Joined
Nov 7, 2011
Messages
2,096
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
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

Well-known Member
Joined
Jun 24, 2015
Messages
1,771
Office Version
  1. 2010
Platform
  1. Windows
@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."
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,972
Messages
5,767,400
Members
425,410
Latest member
SmittyT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top