将多个.xls文件中的内容复制到最后一列中的一个文件和文件名中

我有很多.xls，.csv和/或.xlsx文件，我需要合并成一个大文件。 文件的结构总是相同的。 例如，文件“one”看起来像：

col A 123 456 789 

但有八栏和档“二”，也有八栏，看起来像：

 col A 1011 1213 1415 

目前，我想要复制所有表单和文件名称，结果应该是这样的：

 col A filename 123 one 456 one 789 one 1011 two 1213 two 1415 two 

我想用VBA来解决这个问题。 我发现这个未完成的解决scheme和这样的其他一些VBA部分，但无法插入文件名。 还有一个更复杂/特定的问题的解决scheme，但我还没有想出如何煮代码到我的简单问题。

Answer 1

干得好。

创build一个新的BLANK工作簿并将这些过程放置在一个标准的代码模块中。 保存这个新文件，然后运行Fuji() 。

 Public Sub Fuji() Dim c&, sPath$, sFile$, v, wsReport As Worksheet On Error Resume Next sPath = "c:\tmp\fiji\" '<-- Edit source file folder and INCLUDE final backslash. ActiveSheet.Copy Set wsReport = ActiveSheet wsReport.Name = "Merged" DoEvents sFile = Dir(sPath & "*.*") SetExcelEnvironment 1 Do Application.StatusBar = "Processing... " & sPath & sFile With Workbooks.Open(sPath & sFile) With .Worksheets(1) v = .Range(.[a1], .Cells(.Rows.Count, "a").End(xlUp)) With wsReport.Cells(.Rows.Count, "a").End(xlUp)(2).Resize(UBound(v)) .Value = v .Offset(, 1) = sFile End With End With .Close 0 End With sFile = Dir Loop Until sFile = "" With wsReport .Rows(1).Delete .Cells.EntireColumn.AutoFit End With SetExcelEnvironment 0 End Sub Private Sub SetExcelEnvironment(bProcessing As Boolean) With Application .DisplayAlerts = Not bProcessing .ScreenUpdating = Not bProcessing .StatusBar = "" .DisplayStatusBar = bProcessing End With End Sub 

注意：这里假定只有列A将被收集到报告文件中，并且源文件的名称将被报告在B列中。

注意：这里假定所有的文件都在同一个文件夹中，并且在Fuji()例程的顶部附近的sPath行上编辑该源文件夹的位置。

注意：这假设源文件夹只包含将被这个过程挑选（并被Excel理解）的文件。

注意：这假定所有源文件数据将来自第一张表。

UPDATE

根据您对多列数据的更新要求，请使用以下版本：

 Public Sub Fuji() Dim c&, sPath$, sFile$, v, wsReport As Worksheet On Error Resume Next sPath = "c:\tmp\fiji\" '<-- Edit this and INCLUDE final backslash. sFile = Dir(sPath & "*.*") ActiveSheet.Copy Set wsReport = ActiveSheet wsReport.Name = "Merged" DoEvents SetExcelEnvironment 1 Do Application.StatusBar = "Processing... " & sPath & sFile With Workbooks.Open(sPath & sFile) With .Worksheets(1) v = .[a1].CurrentRegion.Resize(.Cells(.Rows.Count, "a").End(xlUp).Row) With wsReport.Cells(.Rows.Count, "a").End(xlUp)(2).Resize(UBound(v, 1), UBound(v, 2)) .Value = v .Offset(, UBound(v, 2)).Resize(, 1) = sFile End With End With .Close 0 End With sFile = Dir Loop Until sFile = "" With wsReport .Rows(1).Delete .Cells.EntireColumn.AutoFit End With SetExcelEnvironment 0 End Sub Private Sub SetExcelEnvironment(bProcessing As Boolean) With Application .DisplayAlerts = Not bProcessing .ScreenUpdating = Not bProcessing .StatusBar = "" .DisplayStatusBar = bProcessing End With End Sub