合并多个表格数据的代码

经常需要将很多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