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