Import data from multiple Excel files from certain cells

Question

Daily I receive 3 Excel files via e-mail and I need file data on one workbook.

The layout of each file is different.

File names will have current date added.

File 1 name is : BlankApp_yyyymmdd.xls
File 2 name is : DisRep_yyyymmdd.xls
File 3 name is : PerApp_yyyymmdd.xls

From File 1, I need data from B2, A7, D11, G11 (Single row)

From File 2, I need data from A7, C8, E9, H9 (Single row), A11, C12, E13, H13 (single row), A15, C16, E17, H17 (single row) & A19, C20, E21, H21 (single row)

From File 3, I need data from B2, A7, D11, G11 (single row)

In summary I need six rows of data on my workbook, which should accumulate on a daily basis.

---

I found code which gives the outcome I require, but this only resolves part of the question i.e. File1 & File3. Still to find a answer for File2.

Sub BlankandPersonalised()

    Const CellList As String = "B2,A7,D11,G11"
    Const strFldrPath As String = "C:\New folder\" ' point to the folder where the files reside

    Dim wsDest As Worksheet
    Dim rngDest As Range
    Dim rngCell As Range
    Dim arrData() As Variant
    Dim CurrentFile As String
    Dim rIndex As Long, cIndex As Long

    Set wsDest = ActiveWorkbook.ActiveSheet
    CurrentFile = Dir(strFldrPath & "*.xls*")
    Set rngDest = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    ReDim arrData(1 To Rows.Count, 1 To Range(CellList).Cells.Count)

    Application.ScreenUpdating = False
    Do While Len(CurrentFile) > 0
        With Workbooks.Open(strFldrPath & CurrentFile)
            rIndex = rIndex + 1
            cIndex = 0
            For Each rngCell In .Sheets(1).Range(CellList).Cells
                cIndex = cIndex + 1
                arrData(rIndex, cIndex) = rngCell.Value
            Next rngCell
            .Close False
        End With
        CurrentFile = Dir
    Loop
    Application.ScreenUpdating = True

    If rIndex > 0 Then rngDest.Resize(rIndex, UBound(arrData, 2)).Value = arrData

    Set wsDest = Nothing
    Set rngDest = Nothing
    Set rngCell = Nothing
    Erase arrData

End Sub

Answer 1

Option Explicit
Sub test()
    Dim wb As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim vFile As Variant

    'Set source workbook
    Set wb = ActiveWorkbook
    'Open the target workbook
    vFile = Application.GetOpenFilename("Excel-files,*.xls", _
        1, "Select One File To Open", , False)
    'if the user didn't select a file, exit sub
    If TypeName(vFile) = "Boolean" Then Exit Sub
    Workbooks.Open vFile
    'Set targetworkbook
    Set wb2 = ActiveWorkbook

    'For instance, copy data from a range in the first workbook to another range in the other workbook
    wb2.Worksheets("Sheet2").Range("C3:D4").Value = wb.Worksheets("Sheet1").Range("A1:B2").Value
End Sub

Using above should be a good start. Not sure where you want the data or what book you want the macro in.

referenced from here Copy data from another Workbook through VBA

Answer 2

Here is another example of how to pull all the files in one folder into a workbook.
if you just want to copy the entire sheet in one workbook you can use

Sub add_Sheets()

Dim was As Worksheet
Dim wb As Workbook
Set wb = Application.Workbooks.Open("C:\Location of your files") 'Location of where you want the workbook to be

StrFile = Dir("C:\Location\*.xls") 'Dir of where all the xls are.
    Do While Len(StrFile) > 0
        Debut.Print StrFile
        Application.Workbooks.Open ("C:\Location\" & StrFile)
        Set ws = ActiveSheet
        ws.UsedRange.Select  'Used range of the worksheet
        Selection.Copy
        wb.Activate
        wb.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = StrFile
        Range("A1").PasteSpecial Paste:=xlPasteValues
        StrFile = Dir
    Loop
End Sub