Excel 使用多个文件中的数据编译一张工作表

我正在尝试使用来自多个不同表的数据，以相同的布局构建一个新表。 我发现并使用了一个宏，它占用了我50%的时间。但现在我被卡住了

目前，我正在使用三个循环检查文件中是否有我要复制的信息，并将数据复制到新行。
当前结果：
第1行第X列：值A
第2行第X列：值B
第3行第X列：值C

其中X与源文件中表示的数据列相同

目标格式
第1行A列：值A
第1行B列：值B
第1行列C:值C

这是我的代码：

Sub RetrieveDataToThisWB(wb As String)
Dim ActiveWB As Workbook
Dim Rng As Range, ExtractRng As Range, c As Range
Dim DatRow As Long

Set ActiveWB = Workbooks.Open(Filename:=wb, UpdateLinks:=False, ReadOnly:=True)


With ActiveWB.Sheets(2)
    Set Rng = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 26))
    Set ExtractRng = FindAll(Rng, "*Value A*")

If Not ExtractRng Is Nothing Then
    For Each c In ExtractRng

        If c.Row > DatRow Then
            ExportRow = ExportRow + 1

            Sheet1.Range(Sheet1.Cells(ExportRow, 1), Sheet1.Cells(ExportRow, 25)).Value = _
                .Range(.Cells(c.Row, 1), .Cells(c.Row, 25)).Value
            Sheet1.Cells(ExportRow, 27).Value = ActiveWB.Name
            Sheet1.Cells(ExportRow, 28).Value = ActiveWB.FullName
            Sheet1.Cells(ExportRow, 29).Value = Now()
            DatRow = c.Row
        End If
    Next c
End If
End With
With ActiveWB.Sheets(2)
    Set Rng = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 26))
    Set ExtractRng = FindAll(Rng, "*Value B*")

If Not ExtractRng Is Nothing Then
    For Each c In ExtractRng

        If c.Row > DatRow Then
            ExportRow = ExportRow + 1

            Sheet1.Range(Sheet1.Cells(ExportRow, 1), Sheet1.Cells(ExportRow, 25)).Value = _
                .Range(.Cells(c.Row, 1), .Cells(c.Row, 25)).Value
            Sheet1.Cells(ExportRow, 27).Value = ActiveWB.Name
            Sheet1.Cells(ExportRow, 28).Value = ActiveWB.FullName
            Sheet1.Cells(ExportRow, 29).Value = Now()
            DatRow = c.Row
        End If
    Next c
End If
End With
With ActiveWB.Sheets(2)
    Set Rng = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 26))
    Set ExtractRng = FindAll(Rng, "*Value C*")

If Not ExtractRng Is Nothing Then
    For Each c In ExtractRng

        If c.Row > DatRow Then
            ExportRow = ExportRow + 1

            Sheet1.Range(Sheet1.Cells(ExportRow, 1), Sheet1.Cells(ExportRow, 25)).Value = _
                .Range(.Cells(c.Row, 1), .Cells(c.Row, 25)).Value
            Sheet1.Cells(ExportRow, 27).Value = ActiveWB.Name
            Sheet1.Cells(ExportRow, 28).Value = ActiveWB.FullName
            Sheet1.Cells(ExportRow, 29).Value = Now()
            DatRow = c.Row
        End If
    Next c
End If
End With

---

到底是什么问题？您的问题/问题不清楚-“我卡住了”无助于我们帮助您。对不起，先生，问题是我如何才能不将行导出/添加到新工作表中，而只添加单元格。所以每3个循环只填充同一行上的单元格。也许我用这个把头蒙上了水。。。