How to auto populate a single spreadsheet from multiple spreadsheets

Question

I have a set of Excel spreadsheets to summarise. My sheets are numbered: xxx-yy-zzzz; xxx-yy-zzz+1; etc.

I would like a reporting spreadsheet to retrieve information each time it is opened. I don't mind doing it with VBA or with formulae.

I've the macro below. I need to auto increment until it runs out of spreadsheets. All the files will be in the same folder, this file can be in any folder.

Sub Macro1()

'
' Macro1 Macro
' autopop
'
'
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "='[413-05-001.xlsx]Cover'!R4C5"
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "='[413-05-001.xlsx]Cover'!R5C3"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "='[413-05-001.xlsx]Order'!R27C9"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "='[413-05-001.xlsx]Cover'!R8C9"

End Sub

Answer 1

Siddharth's method above worked very well for when we were using very simple file names, but it got a lot harder when there were additions made to the filename... So i did some surfing and found a basis of a "list all files and put them in a worksheet" and using some of the code from Siddharth's answer above (thank you very much Mr. Siddharth) and the example i found online here http://alanmurray.blogspot.com/2013/08/excel-vba-list-all-excel-files-in-folder.html , i have finalised my code, and my little VBA app now does what i want - it opens a folder and goes through and pulls out particular cells and creates a summary report in seconds -> will save me hours of tedious work...

Code:

Sub ImportFileList()
Dim MyFolder As String 'Store the folder selected by the using
Dim FiletoList As String 'store the name of the file ready for listing
Dim NextRow As Long 'Store the row to write the filename to

On Error Resume Next

Application.ScreenUpdating = False

'Display the folder picker dialog box for user selection of directory
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False

    If .SelectedItems.Count = 0 Then
        MsgBox "You did not select a folder"
        Exit Sub
    End If
    MyFolder = .SelectedItems(1) & "\"
End With

'Dir finds the first Excel workbook in the folder
FiletoList = Dir(MyFolder & "*.xls")
Range("A1").Value = "Filename"
Range("B1").Value = "Purchase Order Number" 
Range("C1").Value = "Vendor"
Range("D1").Value = "Date of PO"
Range("E1").Value = "Currency"
Range("F1").Value = "Subtotal"
Range("G1").Value = "VAT"
Range("H1").Value = "Total"
Range("A1:H1").Font.Bold = True

'Find the next empty row in the list
NextRow = Application.CountA(Range("A:A")) + 1 
NextRow = NextRow + 1 ' skip a line

'Do whilst the dir function returns an Excel workbook
Do While FiletoList <> ""
    Cells(NextRow, 1).Value = FiletoList 'Write the filename into the next available cell
    Cells(NextRow, 2).Formula = "='[" & FiletoList & "]Cover'!R4C4" ' Cover is the excel sheet name
    Cells(NextRow, 3).Formula = "='[" & FiletoList & "]Cover'!R6C3"
    Cells(NextRow, 4).Formula = "='[" & FiletoList & "]Cover'!R4C7"
    Cells(NextRow, 5).Formula = "='[" & FiletoList & "]Cover'!R21C4"
    Cells(NextRow, 6).Formula = "='[" & FiletoList & "]Cover'!R19C5"
    Cells(NextRow, 7).Formula = "='[" & FiletoList & "]Cover'!R20C5"
    Cells(NextRow, 8).Formula = "='[" & FiletoList & "]Cover'!R21C5"
    NextRow = NextRow + 1 'Move to next row
    FiletoList = Dir 'Dir returns the next Excel workbook in the folder
Loop

Application.ScreenUpdating = True

End Sub

Answer 2

Is this what you are trying? (UNTESTED)

'~~> Change this to the directory which has .xlsx files
Const sDir = "C:\Temp\"

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long, num As Long, Calcmode As Long
    Dim FilesCount As Long, startNum As Long

    On Error GoTo Whoa

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With Application
        .ScreenUpdating = False
        Calcmode = .Calculation
        .Calculation = xlCalculationManual
    End With

    '~~> Get the number of files in that directory
    FilesCount = getFileCount(sDir)

    startNum = 1

    If FilesCount <> 0 Then
        With ws
            For i = 4 To (FilesCount + 3)
                num = Format(startNum, "000")

                .Range("C" & i).Formula = "='[413-05-" & num & ".xlsx]Cover'!R4C5"
                .Range("D" & i).Formula = "='[413-05-" & num & ".xlsx]Cover'!R5C3"
                .Range("E" & i).Formula = "='[413-05-" & num & ".xlsx]Order'!R27C9"
                .Range("F" & i).Formula = "='[413-05-" & num & ".xlsx]Cover'!R8C9"

                startNum = startNum + 1
            Next i
        End With
    End If

LetsContinue:
    With Application
        .ScreenUpdating = True
        .Calculation = Calcmode
    End With
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Function getFileCount(s As String) As Long
    Dim Path As String, Filename As String
    Dim Count As Long

    Path = s & "*.xlsx"

    Filename = Dir(Path)

    Do While Filename <> ""
        Count = Count + 1
        Filename = Dir()
    Loop

    getFileCount = Count
End Function