Question

有人可以帮我解决下面的问题吗？每天我通过电子邮件收到3个不同的文件，我需要将这些xls文件数据放到一个工作簿上。每个文件的布局是不同的，但是每天接收的文件将采用相同的格式，只有不同的是将当前日期添加到xls文件中。文件1名称为：BlankApp_yyyymmdd.xls /文件2名称为：DisRep_yyyymmdd.xls /文件3名称为：PerApp_yyyymmdd.xls

从文件1，我需要来自文件2的B2，A7，D11，G11（单行）的数据，我需要来自A7，C8，E9，H9（单行），A11，C12，E13，H13的数据（单行），A15，C16，E17，H17（单行）＆amp;来自文件3的A19，C20，E21，H21（单行），我需要来自B2，A7，D11，G11（单行）的数据

总结每天我需要在我的工作簿上有大约6行数据，这些数据应该每天累积。请帮忙。

大家好，我找到了一个代码，它给出了我需要的结果（低于FYR），但这只能解决我的问题，即File1＆amp; 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

从文件二中，我需要从3个不同的行中检索日期 - ＆GT;文件2，我需要来自A7，C8，E9，H9（单行），A11，C12，E13，H13（单行），A15，C16，E17，H17（单行）和数据的数据。 A19，C20，E21，H21（单行）

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

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

2 个答案: