合并多个表格数据的代码

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

1、打开Excel文件直接读取

 1 Sub CombineFiles()
 2     Dim excelApp As Excel.Application
 3     Dim fileName As String
 4     Dim ws As Worksheet
 5     
 6     Application.ScreenUpdating = False
 7     Set excelApp = GetObject(, "Excel.Application")
 8     fileName = Dir(ThisWorkbook.Path & "*.csv")
 9     Do While fileName <> ""
10         Set ws = excelApp.Workbooks.Open(ThisWorkbook.Path & "" & fileName).Worksheets(1)
11         currow = Sheet1.Range("A65535").End(xlUp).Row
12         If currow > 1 Then
13             currow = currow + 1
14             ws.UsedRange.Offset(1, 0).Copy Sheet1.Range("A" & currow)
15         Else
16             ws.UsedRange.Copy Sheet1.Range("A" & currow)
17         End If
18         fileName = Dir
19         ws.Parent.Close
20     Loop
21     Application.ScreenUpdating = True
22 End Sub

2、通过ADO读取数据

 1 Sub CopyFileFromRs()
 2     Dim conn As ADODB.Connection
 3     Dim rs As ADODB.Recordset
 4     Dim fld As ADODB.Field
 5     Dim iCount As Integer
 6     
 7     Set conn = New ADODB.Connection
 8     fileName = Dir(ThisWorkbook.Path & "*.csv")
 9     Do While fileName <> ""
10         With conn
11              .Provider = "Microsoft.Jet.OLEDB.4.0"
12              .ConnectionString = "Data Source=" & ThisWorkbook.Path & "" & fileName & ";" & _
13              "Extended Properties=Excel 8.0;"
14             .Open
15         End With
16         Set rs = New ADODB.Recordset
17         rs.Open "Select * From [Worksheet$]", conn, adOpenKeyset, adLockReadOnly
18         currow = Sheet1.Range("A65535").End(xlUp).Row
19         If currow = 1 And Len(Sheet1.Range("A1")) = 0 Then
20             For Each fld In rs.Fields
21                 iCount = iCount + 1
22                 Sheet1.Cells(1, iCount) = fld.Name
23             Next
24             Sheet1.Range("A2").CopyFromRecordset rs
25         Else
26             currow = currow + 1
27             Sheet1.Range("A" & currow).CopyFromRecordset rs
28         End If
29         fileName = Dir
30         conn.Close
31     Loop
32     
33     Set fld = Nothing
34     Set rs = Nothing
35     Set conn = Nothing
36 End Sub