VBA-将多个工作表中的特定列数据复制到一个

Question

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

源工作簿名称： Mycalc.xlsm

工作表名称： Sheet1, sheet2, sheet3（还有其他工作表，但只能针对提到的工作表执行操作）

目标工作簿名称： Mycalc.xlsm

目标工作表名称：合并

条件：

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

预期结果： 结果是来自所有 3 个工作表的合并数据以及一个列 sheetname，其中提到了数据复制到的工作表。

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

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