使用VBA合并Excel表格
我有一个Excel工作表（说OG.xls），其中有一些数据已经在它的5000行，标题在第一行和高级“AN”列。 这一行（5000）不会改变整整一年。 现在我有5个XL文件（说A，B，C，D，E），并且这些文件中的数据必须从第5001行开始追加到这个OG文件中。 所有这5个文件具有不同的列数，但与OG文件相同。 我必须从这些文件中提取数据，并将它们放在OG文件中。 从文件A：列A，B，C，D，E，F，G和H进入OG.xls文件的列F，G，T，U，V，W，X和Y. 同样，其他文件数据必须根据与OG.xls相对应的列进行提取
第二个文件数据必须附加在文件A结束的下一行的正下方（例如，在从文件A填充数据之后，现在OG.xls具有5110行，文件B数据必须从第5111行的OG .xls。其他文件也一样，这5个文件的数据必须一行一行地填写，但是应该与OG.xls的列匹配
每次通过填充来自第5001行OG.xls的数据重复相同的操作。 为了方便，我们可以将所有这些文件放在同一个文件夹中。
我们应该怎么做。
请帮助我！ 也让我知道任何澄清。
如果你需要一个更准确的答案，你需要先尝试一下，然后在你卡住的地方寻求帮助。 我的build议是从一开始; 1.开始在OG.XLS中编写VBA脚本，作为第一步尝试访问文件A.xls并阅读列并粘贴它们（它们最初可以以任何顺序在任何位置）。 2.一旦你能够做到这一点，下一步是看看你是否把数据放在右栏（在你的例子中说5000），通过设置正确的variablestypes并使用它们并增加它们。 3.下一步应该是阅读A.XLS中的列标题，find它们并标识它们。 最初，你可以开始做一个简单的string比较，稍后你可以细化这个做一个VLOOKUP。 4.在这个过程中，如果遇到任何具体的问题，提出这个问题，以便得到更好的答案。
很less有来自社区的人为你编写完整的代码。
为什么A列在F列结束，为什么C结束在T？ 有没有一个规则，如第一行是与其中的文字相同的标题？
也许一张照片可能有帮助。
基于我所能猜到的，我将每张表放入一个有意义的字段名称的logging集（您需要引用Microsoft ActiveX Data Objects 2.8 Library ）。 一旦完成，将会很容易追加每个RecordSet并将它们放入一张表中。
你需要能够find最后一列和最后一行在每张表中做这个干净的，所以看看我怎么能find最后一行…
编辑…
下面是一个清理的例子，说明如何在VBA中做你所需要的。 魔鬼是在空的床单，如何处理公式（这完全忽略了他们），以及如何以适当的方式（再次忽略）合并你的列的细节。
这已经在Excel 2007中进行了testing。
Option Explicit Const MAX_CHARS = 1200 Sub MergeAllSheets() Dim rs As Recordset Dim mergedRS As Recordset Dim sh As Worksheet Dim wb As Workbook Dim fieldList As New Collection Dim rsetList As New Collection Dim f As Variant Dim cols As Long Dim rows As Long Dim c As Long Dim r As Long Dim ref As String Dim fldName As String Dim sourceColumn As String Set wb = ActiveWorkbook For Each sh In wb.Worksheets Set rs = New Recordset ref = FindEndCell(sh) cols = sh.Range(ref).Column rows = sh.Range(ref).Row If ref <> "$A$1" Or sh.Range(ref).Value <> "" Then '' This is to catch empty sheet c = 1 r = 1 Do While c <= cols fldName = sh.Cells(r, c).Value rs.Fields.Append fldName, adVarChar, MAX_CHARS If Not InCollection(fieldList, fldName) Then fieldList.Add fldName, fldName End If c = c + 1 Loop rs.Open r = 2 Do While r <= rows rs.AddNew c = 1 Do While c <= cols rs.Fields(c - 1) = CStr(sh.Cells(r, c).Value) c = c + 1 Loop r = r + 1 Debug.Print sh.Name & ": " & r & " of " & rows & ", " & c & " of " & cols Loop rsetList.Add rs, sh.Name End If Next Set mergedRS = New Recordset c = 1 sourceColumn = "SourceSheet" Do While InCollection(fieldList, sourceColumn) '' Just in case you merge a merged sheet sourceColumn = "SourceSheet" & c c = c + 1 Loop mergedRS.Fields.Append sourceColumn, adVarChar, MAX_CHARS For Each f In fieldList mergedRS.Fields.Append CStr(f), adVarChar, MAX_CHARS Next mergedRS.Open c = 1 For Each rs In rsetList If rs.RecordCount >= 1 Then rs.MoveFirst Do Until rs.EOF mergedRS.AddNew mergedRS.Fields(sourceColumn) = "Sheet No. " & c For Each f In rs.Fields mergedRS.Fields(f.Name) = f.Value Next rs.MoveNext Loop End If c = c + 1 Next Set sh = wb.Worksheets.Add mergedRS.MoveFirst r = 1 c = 1 For Each f In mergedRS.Fields sh.Cells(r, c).Formula = f.Name c = c + 1 Next r = 2 Do Until mergedRS.EOF c = 1 For Each f In mergedRS.Fields sh.Cells(r, c).Value = f.Value c = c + 1 Next r = r + 1 mergedRS.MoveNext Loop End Sub Public Function InCollection(col As Collection, key As String) As Boolean Dim var As Variant Dim errNumber As Long InCollection = False Set var = Nothing Err.Clear On Error Resume Next var = col.Item(key) errNumber = CLng(Err.Number) On Error GoTo 0 '5 is not in, 0 and 438 represent incollection If errNumber = 5 Then ' it is 5 if not in collection InCollection = False Else InCollection = True End If End Function Public Function FindEndCell(sh As Worksheet) As String Dim cols As Long Dim rows As Long Dim maxCols As Long Dim maxRows As Long Dim c As Long Dim r As Long maxRows = sh.rows.Count maxCols = sh.Columns.Count cols = sh.Range("A1").End(xlToRight).Column If cols >= maxCols Then cols = 1 End If c = 1 Do While c <= cols r = sh.Cells(1, c).End(xlDown).Row If r >= maxRows Then r = 1 End If If r > rows Then rows = r End If c = c + 1 Loop FindEndCell = sh.Cells(rows, cols).Address End Function
我碰到这个问题时，我的一个客户来找我解决scheme合并他们的股票名单，保存在200多个单独的文件。 如果你发现自己像我的客户一样处于相同的位置， 别担心，我写了一个简单的程序来完成这个工作。 :)检查下面的链接：
JMC Excel – join，合并，合并多个Excel工作表或Excel工作簿
问候，JeeShen李www.jeeshenlee.wordpress.com