将10个xls文件合并为一个 [英] Merge 10 xls files into one

问题描述

大家好



我有10 xls报告，每列8列。



所有文件包含相同的列名。



我需要将它们合并到一个xls文件中。



需要帮助继续。



我尝试过的事情：



我用以下方法解决了链接



tps：//www.codeproject.com/Tips/715976/Solutions-to-Merge-Multiple-Excel-Worksheets-int

Hi all

I have 10 xls report with 8 columns each.

All files contains same column names.

I need to merge them to a single xls file.

need help to proceed.

What I have tried:

I resolved using below link

tps://www.codeproject.com/Tips/715976/Solutions-to-Merge-Multiple-Excel-Worksheets-int

推荐答案

这是一篇文章，如果您希望将数据放在单个Excel文件的单独工作表中，这可能很有用。

如何在Excel中将多个工作簿合并到一个工作簿中？ [ ^ ]

及以下

如何将工作表/工作簿合并到一个工作表中？ [ ^ ]



希望，它有所帮助：）

Here is an article, which can be useful if you want your data in separate sheets of a single excel file.
How to combine multiple workbooks to one workbook in Excel?[^]
and following
How to merge worksheets / workbooks into one worksheet?[^]

Hope, it helps :)

这个子程序将通过保存这个主工作簿的文件夹中的所有xls *文件进行读取。它将读取所有这些文件的Sheet1中的所有数据，并将每个文件中的数据附加到当前工作表中。

This subroutine will read thru all xls* files in the folder where this main workbook is saved. It will read all data in "Sheet1" of all of those files and append the data from each one into the current worksheet.

Sub ReadXLFiles()
'set a reference (in Tools / References) to Microsoft ActiveX Data Objects
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnect As String
Dim strSQL As String
Dim recCount As Long
Dim ws As Worksheet
Dim wsTgt As Worksheet
Dim strFileName As String
Dim strFilePath As String
Dim bNeedToWriteHeaders As Boolean
Dim rngTgt As Range
Dim c As Integer

    On Error GoTo ErrorHandler
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    Set wsTgt = ActiveSheet
    Set rngTgt = wsTgt.Range("A1")
    ' clear existing data
    rngTgt.CurrentRegion.Clear
    
    strFilePath = ActiveWorkbook.Path
    
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    strFileName = Dir(strFilePath & "\*.xls*")
    strSQL = "SELECT * FROM [Sheet1

' 假设所有工作簿都有一个数据所在的Sheet1
recCount = 0
bNeedToWriteHeaders = True
执行 while strFileName<>
如果 strFileName <> ActiveWorkbook.Name 然后
Application.StatusBar = 处理文件：& strFileName
strConnect = Provider = Microsoft.ACE.OLEDB.12.0; Data Source = &安培; strFilePath& \& strFileName& ;扩展属性= Excel 12.0;持久安全信息=假

cn.Open strConnect
cn.CommandTimeout = 120

' 运行查询
rs.Open strSQL，cn，adOpenKeyset ' 需要此记录号
如果 rs.RecordCount> 0 然后
如果 bNeedToWriteHeaders 然后
对于 c = 0 rs.Fields.Count - 1
rngTgt.Offset（ 0 ，c）= rs.Fields（c）.Name
下一步
bNeedToWriteHeaders = False
recCount = recCount + 1
End 如果
' 写下结果
rngTgt.Offset（recCount， 0 ）。警察yFromRecordset rs
' 下次写入的更新位置
recCount = recCount + rs。 RecordCount
结束 如果
DoEvents
rs.Close
cn。关闭
结束 如果
strFileName = Dir ' 获取下一个文件名

循环

设置 rs = 没什么
设置 cn = Nothing

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.Scr eenUpdating = True
Application.EnableEvents = True
Application.StatusBar = False

MsgBox 完成。 ，vbExclamation， 感谢Pat！
退出 Sub

ErrorHandler：
MsgBox Err.Description，vbCritical， 对不起戴夫，我做不到......
结束 Sub

" ' assumes all workbooks have a "Sheet1" where the data is located recCount = 0 bNeedToWriteHeaders = True Do While strFileName <> "" If strFileName <> ActiveWorkbook.Name Then Application.StatusBar = "Processing file: " & strFileName strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath & "\" & strFileName & ";Extended Properties=Excel 12.0;Persist Security Info=False" cn.Open strConnect cn.CommandTimeout = 120 'run the query rs.Open strSQL, cn, adOpenKeyset 'need this for record number If rs.RecordCount > 0 Then If bNeedToWriteHeaders Then For c = 0 To rs.Fields.Count - 1 rngTgt.Offset(0, c) = rs.Fields(c).Name Next bNeedToWriteHeaders = False recCount = recCount + 1 End If 'write the results rngTgt.Offset(recCount, 0).CopyFromRecordset rs 'update position for next write recCount = recCount + rs.RecordCount End If DoEvents rs.Close cn.Close End If strFileName = Dir ' get next file name Loop Set rs = Nothing Set cn = Nothing Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True Application.ScreenUpdating = True Application.EnableEvents = True Application.StatusBar = False MsgBox "Done.", vbExclamation, "Thanks Pat!" Exit Sub ErrorHandler: MsgBox Err.Description, vbCritical, "I'm sorry Dave, I can't do that..." End Sub

这篇关于将10个xls文件合并为一个的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！