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

snmarar

New Member
Joined
Feb 19, 2019
Messages
5
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.
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
2,005
Hello and welcome

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

Untested as I need to go home!

Code:
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
 
Last edited:

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,695
Office Version
  1. 365
Platform
  1. Windows
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

Code:
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
 
Last edited:

snmarar

New Member
Joined
Feb 19, 2019
Messages
5

ADVERTISEMENT

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

Well-known Member
Joined
Mar 11, 2015
Messages
6,695
Office Version
  1. 365
Platform
  1. Windows
There is a typo in the Optimise macro
- it is easy to spot
truefale should be TrueFalse
 

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
2,005

ADVERTISEMENT

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

New Member
Joined
Feb 19, 2019
Messages
5
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

New Member
Joined
May 22, 2012
Messages
3
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,010
Office Version
  1. 365
Platform
  1. Windows
@Steve Smith
Please do not "hijack" another members thread, you need to start a thread of your own.
Thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,108,490
Messages
5,523,251
Members
409,506
Latest member
reneekeane

This Week's Hot Topics

Top