VBA-将特定列数据从多个工作表复制为一个

Question

我有一个非常典型的场景，需要将来自不同工作表（在同一工作簿中）的两列复制到单个工作表中。

源工作簿名称： Mycalc.xlsm

工作表名称： Sheet1，sheet2，sheet3（还有其他工作表，但仅针对上述内容执行操作）

目标工作簿名称： Mycalc.xlsm

目标工作表名称：合并

条件：

1. 不能为工作簿中的所有工作表执行每个工作表，因为只对上述三个工作表执行操作。
2. 列标题在所有工作表中的顺序不一定相同，但标题相同。



结果预期： 结果是来自所有3张纸的合并数据以及提示数据复制的纸张的列表名称。

我不是这方面的专家，因此无论我取得了什么，我都不会粘贴代码。添加它，我已经通过在命名范围中添加工作表名称作为列表（在工作簿中我创建了一个具有工作表名称列表的表格，并且在该范围内执行每个工作簿）。



stackoverflow的专家，请帮助我。

此致

摩尼

Answer 1

我已经使用了命名范围的概念作为工作表名称。经过多次跨栏和耗时的研究。这是一个简单的，编译和工作的代码。

Public Sub ExportData()

Dim TransCol(1 To 2) As String
Dim ImportWS As Worksheet
Dim SheetsName As Range
Dim FindColumn, TargetColumn As Range
Dim RowCount As Long
Dim RowIndex, i, Column  As Long
Dim LastUsedRow As Long
Dim LastUsedRowCount As Variant


    TransCol(1) = "ISIN"
    TransCol(2) = "Current Day Adjustment"



For Each SheetsName In sheet3.Range("tblSheetNames").Cells

 If Len(SheetsName.Value) > 0 Then

 Set ImportWS = ThisWorkbook.Sheets(SheetsName.Value)
 ImportWS.Activate

 For Column = 1 To 2

 Set FindColumn = ImportWS.Cells.Find(TransCol(Column), searchorder:=xlByRows, searchdirection:=xlNext)
     RowCount = FindColumn.Cells(200000, 1).End(xlUp).Row
 Set TargetColumn = sheet3.Cells.Find(TransCol(Column), searchorder:=xlByRows, searchdirection:=xlNext)

For i = FindColumn.Row To RowCount

    LastUsedRow = sheet3.Cells(200000, TargetColumn.Column).End(xlUp).Row
    sheet3.Cells(LastUsedRow + 1, TargetColumn.Column).Value = ImportWS.Cells(i + 1, FindColumn.Column).Value

 Next i

 Next Column
End If

Next
End Sub

**注意：**我已将代码移动到模块而不是后面的工作簿代码。

很高兴解释，如果需要更多信息。谢谢大家。

此致

摩尼

Answer 2

你不值得从零开始，没有统一化或努力否则无处可去 既然你显然不打算学习，我也没有真正费心去评论代码。如果我错了，你想了解这些行正在做什么，请随时评论，我会回复。

Sub ertdfgcvb()
ExportWS = "Merged"
Dim ImportWS(1 To 3) As String
    ImportWS(1) = "Sheet1"
    ImportWS(2) = "sheet2"
    ImportWS(3) = "sheet3"
Dim TransCol(1 To 2) As String
    TransCol(1) = "Current Day Adjustment"
    TransCol(2) = "ISIN"
For i = 1 To 3 'for each import sheet
    FirstImportRow = Worksheets(ImportWS(i)).Cells.Find(TransCol(1), SearchOrder:=xlByRows, SearchDirection:=xlNext).Row + 1
    LastImportRow = Worksheets(ImportWS(i)).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    DiffRows = LastImportRow - FirstImportRow
    FirstExportRow = Worksheets(ExportWS).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    ExportColumn = Worksheets(ExportWS).Cells.Find("Sheet Name", SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the sheet name
    Worksheets(ExportWS).Range(Cells(FirstExportRow, ExportColumn), Cells(FirstExportRow + DiffRows, ExportColumn)) = ImportWS(i)
    For j = 1 To 2 'for each column that has to be transported
        ExportColumn = Worksheets(ExportWS).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data
        ImportColumn = Worksheets(ImportWS(i)).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data from
        For k = 0 To DiffRows
            Worksheets(ExportWS).Cells(FirstExportRow + k, ExportColumn) = Worksheets(ImportWS(i)).Cells(FirstImportRow + k, ImportColumn)
        Next
    Next

Next
End Sub