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,

 

[ceytl]

Thanks, johhnyL.

What would you need to change so data can append to the next blank line?

Thank you

 

[johnnyL]

What would you need to change so data can append to the next blank line?

Thank you

Since no one answered, try this for a quick fix:

Sub LoopThroughFilesV2()
'
    Dim wb1 As Workbook, wb2 As Workbook
    Dim SourceDirectory As String, SourcefileName As String, DestinationSheetName As String, SourceSheetName As String
    Dim DestinationRow  As Long
'
    Application.ScreenUpdating = False
    DestinationRow = 1
'
    SourceDirectory = "c:\Users\US\Desktop\S1\"
'
    SourceSheetName = "D1"                                                              ' <--- Set this to the Source Sheet Name that will always be used
    DestinationSheetName = "Sheet1"                                                     ' <--- Set this to the Destination Sheet Name
    SourcefileName = Dir(SourceDirectory & "*.xlsx")                                    ' Save source file name
    Set wb1 = ThisWorkbook

    Do While SourcefileName <> ""
        Set wb2 = Workbooks.Open(SourceDirectory & SourcefileName)
'
        With wb2.Sheets(SourceSheetName)
            DestinationRow = DestinationRow + 1
            wb1.Sheets(DestinationSheetName).Range("A" & DestinationRow) = .Range("B5")
            wb1.Sheets(DestinationSheetName).Range("B" & DestinationRow) = .Range("H7")
            wb1.Sheets(DestinationSheetName).Range("C" & DestinationRow) = .Range("F19")
            wb1.Sheets(DestinationSheetName).Range("D" & DestinationRow) = .Range("F20")
            wb1.Sheets(DestinationSheetName).Range("E" & DestinationRow) = .Range("F21")
        End With
'
        wb2.Close savechanges:=False
        SourcefileName = Dir
    Loop
'
    Application.ScreenUpdating = True
End Sub

 

[ceytl]

Since no one answered, try this for a quick fix:

Sub LoopThroughFilesV2()
'
    Dim wb1 As Workbook, wb2 As Workbook
    Dim SourceDirectory As String, SourcefileName As String, DestinationSheetName As String, SourceSheetName As String
    Dim DestinationRow  As Long
'
    Application.ScreenUpdating = False
    DestinationRow = 1
'
    SourceDirectory = "c:\Users\US\Desktop\S1\"
'
    SourceSheetName = "D1"                                                              ' <--- Set this to the Source Sheet Name that will always be used
    DestinationSheetName = "Sheet1"                                                     ' <--- Set this to the Destination Sheet Name
    SourcefileName = Dir(SourceDirectory & "*.xlsx")                                    ' Save source file name
    Set wb1 = ThisWorkbook

    Do While SourcefileName <> ""
        Set wb2 = Workbooks.Open(SourceDirectory & SourcefileName)
'
        With wb2.Sheets(SourceSheetName)
            DestinationRow = DestinationRow + 1
            wb1.Sheets(DestinationSheetName).Range("A" & DestinationRow) = .Range("B5")
            wb1.Sheets(DestinationSheetName).Range("B" & DestinationRow) = .Range("H7")
            wb1.Sheets(DestinationSheetName).Range("C" & DestinationRow) = .Range("F19")
            wb1.Sheets(DestinationSheetName).Range("D" & DestinationRow) = .Range("F20")
            wb1.Sheets(DestinationSheetName).Range("E" & DestinationRow) = .Range("F21")
        End With
'
        wb2.Close savechanges:=False
        SourcefileName = Dir
    Loop
'
    Application.ScreenUpdating = True
End Sub

Thank you so much!

 

[johnnyL]

You are welcome @ceytl. Glad we could help.

 

[Eric W]

It's worth noting that you can rewrite johnnyL's macro in such a way that you don't have to open/close all those workbooks, possibly saving some time:

Sub LoopThroughFilesV3()
Dim SourceDirectory As String, SourcefileName As String, DestinationSheetName As String, SourceSheetName As String
Dim DestinationRow  As Long, MyCell As Range
'
    Application.ScreenUpdating = False
    DestinationRow = 1                                                                  ' <--- Set this to the top row for the results
'
    SourceDirectory = "c:\Users\US\Desktop\S1\"
'
    SourceSheetName = "D1"                                                              ' <--- Set this to the Source Sheet Name that will always be used
    DestinationSheetName = "Sheet1"                                                     ' <--- Set this to the Destination Sheet Name
    SourcefileName = Dir(SourceDirectory & "*.xlsx")                                    ' Save source file name

    Do While SourcefileName <> ""
        Set MyCell = ThisWorkbook.Sheets(DestinationSheetName).Cells(DestinationRow, "A")
        MyCell.Offset(, 0).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!B5"
        MyCell.Offset(, 1).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!H7"
        MyCell.Offset(, 2).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!F19"
        MyCell.Offset(, 3).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!F20"
        MyCell.Offset(, 4).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!F21"
        MyCell.Resize(1, 5).Value = MyCell.Resize(1, 5).Value
        DestinationRow = DestinationRow + 1
        
        SourcefileName = Dir
    Loop
'
    Application.ScreenUpdating = True
End Sub

 

[ceytl]

It's worth noting that you can rewrite johnnyL's macro in such a way that you don't have to open/close all those workbooks, possibly saving some time:

Sub LoopThroughFilesV3()
Dim SourceDirectory As String, SourcefileName As String, DestinationSheetName As String, SourceSheetName As String
Dim DestinationRow  As Long, MyCell As Range
'
    Application.ScreenUpdating = False
    DestinationRow = 1                                                                  ' <--- Set this to the top row for the results
'
    SourceDirectory = "c:\Users\US\Desktop\S1\"
'
    SourceSheetName = "D1"                                                              ' <--- Set this to the Source Sheet Name that will always be used
    DestinationSheetName = "Sheet1"                                                     ' <--- Set this to the Destination Sheet Name
    SourcefileName = Dir(SourceDirectory & "*.xlsx")                                    ' Save source file name

    Do While SourcefileName <> ""
        Set MyCell = ThisWorkbook.Sheets(DestinationSheetName).Cells(DestinationRow, "A")
        MyCell.Offset(, 0).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!B5"
        MyCell.Offset(, 1).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!H7"
        MyCell.Offset(, 2).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!F19"
        MyCell.Offset(, 3).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!F20"
        MyCell.Offset(, 4).Formula = "='" & SourceDirectory & "[" & SourcefileName & "]" & SourceSheetName & "'!F21"
        MyCell.Resize(1, 5).Value = MyCell.Resize(1, 5).Value
        DestinationRow = DestinationRow + 1
       
        SourcefileName = Dir
    Loop
'
    Application.ScreenUpdating = True
End Sub

Thank you!

Is there a way to change the DestinationSheetName to the 1st or active worksheet in the workbook, since some of the worksheets don't have the same name, and all my .xlsx have only one worksheet per file.

Lastly, is there a way to change the destination directory to something that would allow me to share the macro without changing the script.

The spreadsheet could be in folder S1 on the desktop, and all the files could be in a folder name S2 that is located in S1.

Thanks!

 

[johnnyL]

I think you are confusing Destination with Source @ceytl. Please rephrase your last post.

 

[johnnyL]

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,

Are all of the desired sheet names "D1" or not?

Do you want "D1" or the only sheet in the xlsx file?

 

[ceytl]

Are all of the desired sheet names "D1" or not?

Do you want "D1" or the only sheet in the xlsx file?

All the sheets I have been working with are named D1, but I want to search other sheets that are named different, is there a way to search for the first sheet in .xlsx file?

 

[Eric W]

All the sheets I have been working with are named D1, but I want to search other sheets that are named different, is there a way to search for the first sheet in .xlsx file?

In my version, no. You have to know the complete address of the cell. In johnnyL's version, you can change this line:

With wb2.Sheets(SourceSheetName)

to

With wb2.Sheets(1)

to get the data from the first sheet.

As far as looking in different folders, you have to tell the macro (either version) where to look. I can't think of any way for the macro to decide where to look by itself.