VBA Macro to extract data from every file in a folder and copy data into the open workbook

[snmarar]

Hi All,

I am looking to write a VBA code,

• to extract a couple of cells, DATE and AMOUNT, from each workbook in a folder
• cells containing DATE and AMOUNT are located in "Sheet 1" of each workbook, in cells C4 and G8
• workbook names are similar in nature, for example “F1 JAN 02.xlsx”
• finally, copy and paste DATE and VALUE in
  cells A4 and B4 respectively in ​
  Sheet 1 of the open workbook “Summary.xlsx”

Your assistance in this is greatly appreciated.

Thanks and regards,
Sanjeev.

 

[gallen]

Hello and welcome

Heres some primitive code. Ensure to set the path to where your files are:

Untested as I need to go home!

Sub ImportInfo()
    Dim sPath As String 'path of folder containing info
    Dim sFileName As String '
    Dim wsSummary As Worksheet 'worksheet to paste data to in this workbook
    Dim wsData As Worksheet 'sheet with data to copy
    Dim wb As Workbook 'workbooks to loop thorugh
    Dim nr As Long 'next row to add the data
    
    
    'Get the worksheet to add the info to
    Set wsSummary = ThisWorkbook.Worksheets("Sheet1")
    
    'first row is 4
    nr = 4
    
    sPath = "C:\Test\" '[COLOR=#ff0000][B]Change as required[/B][/COLOR]
    
    sFileName = Dir(sPath & "*.xlsx")
    
    Do While sFileName <> ""
        'open workbook
        Set wb = Workbooks.Open(Filename:=sPath & sFileName, ReadOnly:=True)
        'get the sheet to copy from
        Set wsData = wb.Sheets("Sheet1")
        'get the data
        wsSummary.Range("A" & nr).Value = wsData.Range("C4").Value
        wsSummary.Range("B" & nr).Value = wsData.Range("G8").Value
        'get next row
        nr = nr + 1
        'close the workbook
        wb.Close
        'get next workbook name
        sFileName = Dir
    Loop
    
    
End Sub

 

[snmarar]

Thank you.

I will test it and revert.

 

[Yongle]

Here is a very quick method - the workbooks are not opened
Test on a copy of your workbook

Assumes EVERY workbook contains a sheet named "Sheet 1"
Sheet in main workbook "Sheet X" can have a different name
Only Excel files are contained in the folder
For testing, filemame is written to column C
Amend myPath and end with path separator

Sub GetValues()
    Const myPath = "C:\filepath\end with[COLOR=#ff0000]\[/COLOR]"   'do not forget to end with path separator\
    Dim myFile  As String, mySheet As String, r As Long, C4 As Variant, G8 As Variant, arg As String
    Dim rng     As Range:   Set rng = ThisWorkbook.Sheets("[COLOR=#0000cd]Sheet X[/COLOR]").Range("A3:C3")
    
    Optimise True
    myFile = Dir(myPath)
    mySheet = "[COLOR=#ff0000]Sheet 1[/COLOR]"
    Do While myFile <> ""
        On Error Resume Next
        C4 = ExecuteExcel4Macro("'" & myPath & "[" & myFile & "]" & mySheet & "'!" & Range("C4").Range("A1").Address(, , xlR1C1))
        G8 = ExecuteExcel4Macro("'" & myPath & "[" & myFile & "]" & mySheet & "'!" & Range("G8").Range("A1").Address(, , xlR1C1))
        r = r + 1
        rng.Offset(r).Value = Array(C4, G8, myFile)
        myFile = Dir
  Loop
  Optimise False
End Sub

Private Sub Optimise(TrueFalse As Boolean)
    With Application
        .ScreenUpdating = Not TrueFalse
        .EnableEvents = Not truefale
        .Calculation = xlCalculationAutomatic
        If TrueFalse Then .Calculation = xlCalculationManual
    End With
End Sub

 

[snmarar]

Hi,

The earlier one worked. Thank you.

I will try the latter as well and revert.

Supposing I had an array of dates and amounts in each workbook, row or column how would I perform?

Thanks.

 

[Yongle]

There is a typo in the Optimise macro
- it is easy to spot
truefale should be TrueFalse

 

[gallen]

Hi,

The earlier one worked. Thank you.

I will try the latter as well and revert.

Supposing I had an array of dates and amounts in each workbook, row or column how would I perform?

Thanks.

Happy it works.

With regards to your question, not sure I get what you mean. AT the moment it just does as you asked which is to get the data from Cells C4 and G8 of every file and copy them to the summary sheet.

Where would these arrays be? Would these need copying over too?

 

[snmarar]

Thank you for your response.

Apologies, I should have provided you more details.

Basically, each workbook has a sheet with a set of dates and corresponding amounts. Workbooks reside in a folder. That is, Sheet 1 has A4:A10 with dates and B4:B10 with amounts.

I want to copy dates and amounts from each workbook and copy them to an open workbook.

Hope this helps.

Thanks and regards.

 

[Steve Smith]

Hello
Is it possible to use this code and change it to copy a known range from the workbooks say A1:F8 and place that in the next available row of the target workbook?
Thanks

 

[Fluff]

@Steve Smith
Please do not "hijack" another members thread, you need to start a thread of your own.
Thanks