合并多个表格数据的代码

经常需要将很多Excel表格的数据内容进行合并处理，这里我放上来一个案例，并提供2种通过VBA代码实现的方式。案例的详细内容可以在以下链接下载http://yunpan.cn/cmSgUBrqGji3p；访问密码：9f12。

1、打开Excel文件直接读取

Sub CombineFiles()
    Dim excelApp As Excel.Application
    Dim fileName As String
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    Set excelApp = GetObject(, "Excel.Application")
    fileName = Dir(ThisWorkbook.Path & "*.csv")
    Do While fileName <> ""
        Set ws = excelApp.Workbooks.Open(ThisWorkbook.Path & "" & fileName).Worksheets(1)
        currow = Sheet1.Range("A65535").End(xlUp).Row
        If currow > 1 Then
            currow = currow + 1
            ws.UsedRange.Offset(1, 0).Copy Sheet1.Range("A" & currow)
        Else
            ws.UsedRange.Copy Sheet1.Range("A" & currow)
        End If
        fileName = Dir
        ws.Parent.Close
    Loop
    Application.ScreenUpdating = True
End Sub

2、通过ADO读取数据

Sub CopyFileFromRs()
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim iCount As Integer
    
    Set conn = New ADODB.Connection
    fileName = Dir(ThisWorkbook.Path & "*.csv")
    Do While fileName <> ""
        With conn
             .Provider = "Microsoft.Jet.OLEDB.4.0"
             .ConnectionString = "Data Source=" & ThisWorkbook.Path & "" & fileName & ";" & _
             "Extended Properties=Excel 8.0;"
            .Open
        End With
        Set rs = New ADODB.Recordset
        rs.Open "Select * From [Worksheet$]", conn, adOpenKeyset, adLockReadOnly
        currow = Sheet1.Range("A65535").End(xlUp).Row
        If currow = 1 And Len(Sheet1.Range("A1")) = 0 Then
            For Each fld In rs.Fields
                iCount = iCount + 1
                Sheet1.Cells(1, iCount) = fld.Name
            Next
            Sheet1.Range("A2").CopyFromRecordset rs
        Else
            currow = currow + 1
            Sheet1.Range("A" & currow).CopyFromRecordset rs
        End If
        fileName = Dir
        conn.Close
    Loop
    
    Set fld = Nothing
    Set rs = Nothing
    Set conn = Nothing
End Sub