Excel 将多个工作簿合并到一个工作表中

我目前正在尝试将记录在excel工作簿中的数据自动复制到一张“海量数据”表上。文件以日期命名，例如“5-28-17”。一个月的每一天都有一个。如前所述，我想将所有数据收集到一张表中，按日期降序排列。 我目前正在使用这段代码，它应该将所有不同的工作簿放在它们自己的工作表上，但我也有一些问题

 Option Explicit
Const path As String = "C:\Users\dt\Desktop\dt kte\"
Sub GetSheets()
Dim FileName As String
Dim wb As Workbook
Dim sheet As Worksheet

FileName = Dir(path & "*.xls*")
Do While FileName <> ""
Set wb = Workbooks.Open(FileName:=path & FileName, ReadOnly:=True)
For Each sheet In wb.Sheets
    sheet.Copy After:=ThisWorkbook.Sheets(1)
Next sheet
wb.Close
FileName = Dir()
Loop
End Sub

选项显式
常量路径为String=“C:\Users\dt\Desktop\dt kte\”
子表（）
将文件名设置为字符串
将wb设置为工作簿
将工作表设置为工作表
FileName=Dir（路径&“*.xls*”）
文件名“”时执行此操作
设置wb=Workbooks.Open（文件名：=path&FileName，只读：=True）
对于wb.Sheets中的每张工作表
sheet.Copy After:=此工作簿.Sheets（1）
下一页
wb.关闭
FileName=Dir（）
环
端接头

---

我正试图用VBA实现这一点。在我从中提取的工作表和我要复制到的工作表中有15列。都排好了。是否有一种方法可以将我目前正在处理的WB中的工作表从包含每个WB工作表的工作表移动到一个批量工作表中？或者我可以直接从文件夹中提取所有数据，并将所有工作簿按日期保存到一个工作表中吗？

我将使用此加载项

---

它可以做你想做的事情，而且还可以做更多的事情。

考虑使用MS Access数据库。如果没有安装Office GUI.exe应用程序，请不要担心。因为您使用的是Windows计算机，所以确实有其Jet/ACE SQL引擎（.dll文件）

创建数据库

Sub CreateDatabase()
On Error GoTo ErrHandle
    Dim fso As Object, olDb As Object, db As Object
    Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"    
    Const strpath As String = "C:\Path\To\ExcelDatabase.accdb"

    ' CREATE DATABASE
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set olDb = CreateObject("DAO.DBEngine.120")

    If Not fso.FileExists(strpath) Then
        Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
    End If

    MsgBox "Successfully created database!", vbInformation

ExitSub:
    Set db = Nothing: Set olDb = Nothing: Set fso = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitSub
End Sub

创建、填充、导出EXCEL表格（EXCEL文件从未打开）

Sub-CreateTable（）
关于错误转到错误句柄
Dim conn作为对象，rst作为对象
Dim constr为字符串，文件名为字符串，i为整数
Const xlpath As String=“C:\Users\dt\Desktop\dt kte\”
Const accpath As String=“C:\Path\To\ExcelDatabase.accdb”
'连接到数据库
constr=“Provider=Microsoft.ACE.OLEDB.12.0；数据源=“&accpath&；”
Set conn=CreateObject（“ADODB.Connection”）
康涅狄格开放式建筑
i=1
FileName=Dir（xlpath&“*.xls*”）
文件名“”时执行此操作
如果i=1，那么
'通过生成表查询创建表
连接。执行“选择*进入MyExcelTable”\u
&“从[Excel 12.0 Xml；HDR=Yes；”_
&“Database=“&xlpath&FileName&]”。[Sheet1$]
其他的
'通过追加查询填充
连接执行“插入MyExcelTable”\u
&“从[Excel 12.0 Xml；HDR=Yes]中选择*_
&“Database=“&xlpath&FileName&]”。[Sheet1$]
如果结束
i=i+1
FileName=Dir（）
环
'导出到EXCEL
Set rst=CreateObject（“ADODB.Recordset”）
rst.打开“从MyExcelTable中选择*”，康涅狄格州
此工作簿。工作表（“海量数据”）。范围（“A1”）。复制自记录集rst
"密切联系",
rst.关闭：康涅狄格州关闭
MsgBox“已成功创建并填充表！”，vbInformation
进出口银行：
设置rst=无：设置conn=无
出口接头
错误句柄：
MsgBox错误编号&“-”错误描述，vbCritical，“运行时错误”
恢复出口
端接头

谢谢，我不知道这存在代码运行，但没有输出。知道为什么吗？请查看这个，因为它有更多的注释可能会帮助您了解如何实现它。这会每次创建一个数据库吗？使用access有什么好处？只需创建一次数据库。使用数据库可以避免文件系统文件夹中的数百个电子表格。您可以集中、规范化和高效地存储所有需要的数据。好的，谢谢。我应该在数据库代码运行一次后删除它吗？这一切都取决于您如何部署。数据库可能会移动或需要重新创建。请记住，Access数据库是文件级的，因此驻留在目录中而不是服务器中。此外，如果重新运行此宏，可能需要删除已创建的表，

conn.Execute“drop table MyExcelTable”

。

Sub CreateTable()
On Error GoTo ErrHandle
    Dim conn As Object, rst As Object
    Dim constr As String, FileName As String, i As Integer
    Const xlpath As String = "C:\Users\dt\Desktop\dt kte\"
    Const accpath As String = "C:\Path\To\ExcelDatabase.accdb"

    ' CONNECT TO DATABASE
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & accpath & ";"
    Set conn = CreateObject("ADODB.Connection")
    conn.Open constr

    i = 1
    FileName = Dir(xlpath & "*.xls*")  

    Do While FileName <> ""
        If i = 1 Then
            ' CREATE TABLE VIA MAKE TABLE QUERY
            conn.Execute "SELECT * INTO MyExcelTable" _ 
                          & " FROM [Excel 12.0 Xml;HDR=Yes;" _
                          & " Database=" & xlpath & FileName & "].[Sheet1$]"
        Else 
            ' POPULATE VIA APPEND QUERY
            conn.Execute "INSERT INTO MyExcelTable" _ 
                          & " SELECT * FROM [Excel 12.0 Xml;HDR=Yes;" _
                          & " Database=" & xlpath & FileName & "].[Sheet1$]"
        End If

        i = i + 1
        FileName = Dir()
    Loop

   ' EXPORT TO EXCEL
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "SELECT * FROM MyExcelTable", conn

    ThisWorkbook.Worksheets("MASS_DATA").Range("A1").CopyFromRecordset rst

    ' CLOSE CONNECTION
    rst.Close: conn.Close

    MsgBox "Successfully created and populated table!", vbInformation

ExitSub:
    Set rst = Nothing: Set conn = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitSub    
End Sub