Read data from closed worksheets

[Lynton]

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

 

[mumps]

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]

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]

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.

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]

Here another macro for you to consider:

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]

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.

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]

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.

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]

Here another macro for you to consider:

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]

Glad we could help & thanks for the feedback

 

[Lynton]

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