Read data from closed worksheets

Lynton

New Member
Joined
Mar 13, 2011
Messages
19
I use excel to produce work invoices. I have 1000ish invoices in a folder called "invoices" the individual invoices are named inv100001 to inv101000, each invoice has the customers name and address in cells A13, A14, A15, A16, A17, A18,.
I would like to recover and store these name and address in another spreadsheet (called Address) obviously I don't want to alter any details on the already saved invoices.
Ideally I would like to automatically open each invoice in turn .
copy A13 in the inv100001 to A1 in the new address spreadsheet
copy A14 in the inv100001 to B1
copy A15 in the inv100001 to C1
copy A16 in the inv100001 to D1
copy A17 in the inv100001 to E1
copy A18 in the inv100001 to F1
then close the invoice, open the next invoice
and copy those details to row B.
At the finish I would like all the customers details in rows in the address spreadsheet.

any help greatly appreciated
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,639
What is the full path to the "invoices" folder? What is the extension of the files (xlsx, xlsm)? Are those files the only files in that folder?
copy those details to row B.
By the above, I assume you mean row 2.
 

Lynton

New Member
Joined
Mar 13, 2011
Messages
19
What is the full path to the "invoices" folder? What is the extension of the files (xlsx, xlsm)? Are those files the only files in that folder?

By the above, I assume you mean row 2.

Hi thanks for replying.
Yes your correct it should be row 2.
Files are all in folder C:\invoices, nothing else in there.
All files are .xlsx

Lynton
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,639
Place this macro in a regular module in your destination workbook. Make sure that it has a sheet named "Address". I assumed that the range you want to copy in your invoice files is in a sheet named "Sheet1". You can change that sheet name in the code (in red) to suit your needs.
Rich (BB code):
Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wsDest As Worksheet, wkbSource As Workbook
    Set wsDest = ThisWorkbook.Sheets("Address")
    Const strPath As String = "C:\invoices\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wsDest
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(, 6).Value = WorksheetFunction.Transpose(Sheets("Sheet1").Range("A13:A18"))
        End With
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    wsDest.Rows(1).Delete
    Application.ScreenUpdating = True
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,908
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Here another macro for you to consider:

VBA Code:
Sub Read_data_from_closed_worksheets()
  Dim sPath As String, sFile As String, sh As Worksheet
  
  Application.ScreenUpdating = False
  Set sh = ThisWorkbook.Sheets("Address")
  sPath = "C:\invoices\"
  sFile = Dir(sPath & "*.xls*")
  
  Do While sFile <> ""
    With GetObject(sPath & sFile)
      sh.Range("A" & Rows.Count).End(3)(2).Resize(1, 6).Value = Application.Transpose(.Sheets(1).[A13:A18].Value)
      .Close 0
    End With
    sFile = Dir()
  Loop
  Application.ScreenUpdating = True
End Sub
 

Lynton

New Member
Joined
Mar 13, 2011
Messages
19
Place this macro in a regular module in your destination workbook. Make sure that it has a sheet named "Address". I assumed that the range you want to copy in your invoice files is in a sheet named "Sheet1". You can change that sheet name in the code (in red) to suit your needs.
Rich (BB code):
Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wsDest As Worksheet, wkbSource As Workbook
    Set wsDest = ThisWorkbook.Sheets("Address")
    Const strPath As String = "C:\invoices\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wsDest
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(, 6).Value = WorksheetFunction.Transpose(Sheets("Sheet1").Range("A13:A18"))
        End With
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    wsDest.Rows(1).Delete
    Application.ScreenUpdating = True
End Sub
 

Lynton

New Member
Joined
Mar 13, 2011
Messages
19

ADVERTISEMENT

Place this macro in a regular module in your destination workbook. Make sure that it has a sheet named "Address". I assumed that the range you want to copy in your invoice files is in a sheet named "Sheet1". You can change that sheet name in the code (in red) to suit your needs.
Rich (BB code):
Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wsDest As Worksheet, wkbSource As Workbook
    Set wsDest = ThisWorkbook.Sheets("Address")
    Const strPath As String = "C:\invoices\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wsDest
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(, 6).Value = WorksheetFunction.Transpose(Sheets("Sheet1").Range("A13:A18"))
        End With
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    wsDest.Rows(1).Delete
    Application.ScreenUpdating = True
End Sub


Many thanks for your help it worked first time.
 

Lynton

New Member
Joined
Mar 13, 2011
Messages
19
Here another macro for you to consider:

VBA Code:
Sub Read_data_from_closed_worksheets()
  Dim sPath As String, sFile As String, sh As Worksheet
 
  Application.ScreenUpdating = False
  Set sh = ThisWorkbook.Sheets("Address")
  sPath = "C:\invoices\"
  sFile = Dir(sPath & "*.xls*")
 
  Do While sFile <> ""
    With GetObject(sPath & sFile)
      sh.Range("A" & Rows.Count).End(3)(2).Resize(1, 6).Value = Application.Transpose(.Sheets(1).[A13:A18].Value)
      .Close 0
    End With
    sFile = Dir()
  Loop
  Application.ScreenUpdating = True
End Sub
Many thanks this worked perfectly.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,908
Office Version
  1. 2007
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Lynton

New Member
Joined
Mar 13, 2011
Messages
19
Glad we could help & thanks for the feedback
If I wanted to select random cells from the same sheet how would I change macro.
ie Resize(1, 6).Value = Application.Transpose(.Sheets(1).[A13:A18].Value) : selects 6 cells from A13:A18
but if I wanted to select 4 cells E6, E4, A13 and E34. how would I write this.

Lynton
 

Forum statistics

Threads
1,147,498
Messages
5,741,504
Members
423,663
Latest member
kaveh87rsh

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