从某些单元格导入多个Excel文件中的数据

Question

[每天我通过电子邮件收到3个Excel文件，并且我需要在一本工作簿上的文件数据。

每个文件的布局都不同。

文件名将添加当前日期。

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

从文件1，我需要来自B2，A7，D11，G11的数据（单行）

从文件2，我需要来自A7，C8，E9，H9（单行），A11，C12，E13，H13（单行），A15，C16，E17，H17（单行）和A19，C20， E21，H21（单行）

从文件3，我需要来自B2，A7，D11，G11（单行）的数据

总而言之，我在工作簿上需要六行数据，这些数据应该每天累积。

---

我找到了可以提供所需结果的代码，但这仅解决了部分问题，即File1和File3。仍在寻找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

使用上面应该是一个好的开始。不确定要在哪里数据或要将宏放在哪本书中。

从这里引用Copy data from another Workbook through VBA

Answer 2

这里是如何将一个文件夹中的所有文件拉入工作簿的另一个示例。如果您只想将整个工作表复制到一个工作簿中，则可以使用

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