excel - 通过浏览数据选择文件夹中的多个 Excel 文件

Question

我通过网站源获得了这段代码。 https://www.xelplus.com/excel-vba-getopenfilename/

从这里我每天创建 VBA 代码，每天插入数据（每天数据）。

但现在我需要选择一个文件夹中的所有 Excel 或多选并生成它（按月计算数据）。- 客观的

这是描述：

Excel（TOT 流程）v2

• 工作表“控制”作为生成报告的地方
• 工作表“Bank 1”作为数据汇总并在工作表 Data Coll A 中按公式链接
• 收集所有数据时工作表“Data Coll A”

文件夹源数据 - Excel 1,2,3...

• 工作表“详细报告和用户”作为详细信息用户

• 需要收集数据时使用“NAT Cash Float”表

这里示例 VBA 代码（日期 1）

'DATE 1     
Sub Generate_Type1_Date1()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy 'Range Copy
        ThisWorkbook.Worksheets("Data Coll A").Range("C1").PasteSpecial xlPasteValues 'Range Paste
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Sheets("Control").Select
End Sub     

这里是我按日期更改的 VBA 代码

'Date 1
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("C1").PasteSpecial xlPasteValues

'Date 2  
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("AD1").PasteSpecial xlPasteValues

'Date 3
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("BE1").PasteSpecial xlPasteValues

'Date 4
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("CF1").PasteSpecial xlPasteValues

'Date 5
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("DG1").PasteSpecial xlPasteValues

'Date 6
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("EH1").PasteSpecial xlPasteValues

'Date 7
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("FI1").PasteSpecial xlPasteValues

'Date 8
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("GI1").PasteSpecial xlPasteValues

'Date 9
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("HK1").PasteSpecial xlPasteValues

'Date 10
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("IL1").PasteSpecial xlPasteValues

'Date 11
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("JM1").PasteSpecial xlPasteValues

'Date 12
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("KN1").PasteSpecial xlPasteValues

'Date 13
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("LO1").PasteSpecial xlPasteValues

'Date 14
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("MP1").PasteSpecial xlPasteValues

'Date 15
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("NQ1").PasteSpecial xlPasteValues

'Date 16
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("OR1").PasteSpecial xlPasteValues

'Date 17
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("PS1").PasteSpecial xlPasteValues

'Date 18
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("QT1").PasteSpecial xlPasteValues

'Date 19
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("RU1").PasteSpecial xlPasteValues

'Date 20
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("SV1").PasteSpecial xlPasteValues

'Date 21
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("TW1").PasteSpecial xlPasteValues

'Date 22
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("UX1").PasteSpecial xlPasteValues

'Date 23
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("VY1").PasteSpecial xlPasteValues

'Date 24
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("WZ1").PasteSpecial xlPasteValues

'Date 25
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("YA1").PasteSpecial xlPasteValues

'Date 26
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ZB1").PasteSpecial xlPasteValues

'Date 27
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("AAC1").PasteSpecial xlPasteValues

'Date 28
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ABD1").PasteSpecial xlPasteValues

'Date 29
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ACE1").PasteSpecial xlPasteValues

'Date 30
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("ADF1").PasteSpecial xlPasteValues

'Date 31
OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy
ThisWorkbook.Worksheets("Data Coll A").Range("AEG1").PasteSpecial xlPasteValues

Google Drive 中的示例模板：

这里

我真的很感谢你的帮助。TQ

对不起我的英语不好。

标签： excelvba

Answer 1

这是你要找的吗？

   'DATE 1     
    Sub Generate_Type1_Date1()
        Dim FileToOpen As Variant
        Dim OpenBook As Workbook
        Dim PasteTo As Integer
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        PasteTo = 3
        FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*", MultiSelect:=True)
        On Error Goto exitSub
            For Each item in FileToOpen
                Set OpenBook = Application.Workbooks.Open(item)
                OpenBook.Sheets("NAT Cash Float").Range("B:Z").Copy 'Range Copy
                ThisWorkbook.Worksheets("Data Coll A").Cells(1, PasteTo).PasteSpecial xlPasteValues 'Range Paste
                OpenBook.Close False
                PasteTo = PasteTo + 25
            Next
            
        On Error Goto 0
    exitSub:
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Sheets("Control").Select
    End Sub