VBA做列合并

Question

我正在尝试制作一份合并财务报表，在最后一栏中显示子公司和合并数字的所有详细信息（我计划使用公式计算合并总数字）。我正在尝试从选定的文件中复制一些特定的工作表列（比如说 C 列）（每个文件只有一张具有完全相同的布局、结构和基本数据的工作表），然后将其粘贴到一个主工作表（新添加）中以显示从左到右主表 B 列中每个文件的 C 列详细信息。另外，我想在主表的第 1 行显示每个文件的名称，但我仍然不知道如何将它放入我的代码中。

这是我的代码。到目前为止，我在excel 2010中运行它后，发现每一列都是一样的。我不知道出了什么问题。我有 60 多个文件来做这个详细的合并。任何帮助将不胜感激。谢谢。

Sub CombineSheetColumn()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
HeaderRow As Long
Dim DataRng As Range, OutRng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
'initialize constants

HeaderRow = 2 'assume headers are always in row 2
LastOutCol = 1

'select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
  With TargetFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
  End With

'set up the output workbook
  Set OutBook = Workbooks.Add
  Set OutSheet = OutBook.Sheets(1)

'loop through all selected files
  For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet
  Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
  Set DataSheet = DataBook.ActiveSheet

    Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 3), DataSheet.Cells(32, 3))
    Set OutRng = Range(OutSheet.Cells(HeaderRow + 1, 2), OutSheet.Cells(32, LastOutCol + 1))     
'copy the data to the outbook
  DataRng.Copy OutRng

'close the data book without saving
  DataBook.Close False

'update the last outbook row
  LastOutCol = OutSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column  
Next FileIdx
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

要获取源工作簿的文件名，您可以使用：

Cells(32, LastOutCol + 1).value=TargetFiles.SelectedItems(FileIdx).Name

对于所有相同的数据，您可以通过在行上添加断点来逐步检查循环的每次迭代中源工作簿中复制的列：

DataRng.Copy OutRng