VBA-用于将动态信息复制和粘贴到摘要选项卡的宏

这里的第一个问题和一个正在融化我可怜的大脑的问题

我有一个工作簿，它有6个选项卡。这些选项卡是公司的不同部门。每个选项卡包含不同的标题，如“员工编号”或“名字”或“第二个名字”。不同选项卡中的标题不都在相同的列中。（信息来自6个不同的工资单）。由于解雇和雇佣等原因，信息每月都在变化。信息是动态的

我想把它们合并成一个长长的列表

例如：

我希望VBA将tab1中A列的信息复制到tab7（摘要选项卡）中的A列，然后将tab2中A列的信息复制到tab7中A列的下一个空白单元格中，依此类推，用于其他分区选项卡

最后，我想留下一张完整的清单，上面有我需要的所有信息。我希望每个月都能为此运行一个宏，以节省所有浪费时间的复制和粘贴

非常感谢你的帮助。到目前为止，我的努力以失败告终

Sub Test2()
'
' Test2 Macro
'Dim s1 As Excel.Worksheet
Dim s2 As Excel.Worksheet
Dim iLastCellS2 As Excel.Range
Dim iLastRowS1 As Long

Set s1 = Sheets("BaulderStone")
Set s2 = Sheets("Flattened Contribution File ")

'iLastRowS1 = s1.Cells(s1.Rows.Count, "A").End(xlUp).Row

'Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

's1.Range("A1", s1.Cells(iLastRowS1, "A")).Copy iLastCellS2

'Dim s3 As Excel.Worksheet
Dim s2 As Excel.Worksheet
Dim iLastCellS2 As Excel.Range
Dim iLastRowS1 As Long
Set s3 = Sheets("Retirement Living")
Set s2 = Sheets("Flattened Contribution File ")

' iLastRowS3 = s3.Cells(s1.Rows.Count, "D").End(xlUp).Row

' Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

's3.Range("A1", s3.Cells(iLastRowS3, "A")).Copy iLastCellS2
'
End Sub

---

如果仅从每个工作表复制一列，并且该列位于每个不同源工作表的固定位置：

Sub Test3()

    Const CONSOLIDATED As String = "Flattened Contribution File"
    Dim wb As Workbook, sht As Worksheet, shtC As Worksheet
    Dim c As Long

    Set wb = ActiveWorkbook

    On Error Resume Next
    Set shtC = wb.Worksheets(CONSOLIDATED)
    On Error GoTo 0

    If shtC Is Nothing Then
        Set shtC = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        shtC.Name = CONSOLIDATED
    End If

    For Each sht In wb.Worksheets

        Select Case sht.Name
            Case "BaulderStone": c = 1       'get from ColA
            Case "Retirement Living": c = 4  'get from ColD
            'add your other sheets here....
            Case Else: c = 0
        End Select

        If c > 0 Then
            sht.Range(sht.Cells(2, c), sht.Cells(Rows.Count, c).End(xlUp)).Copy _
              shtC.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If

    Next sht

End Sub

编辑：如果每个源工作表的源列和目标列相同，那么类似的操作应该可以工作。注意：每个源工作表第1行中必须有标题

Sub Test4()

    Const CONSOLIDATED As String = "Flattened Contribution File"
    Dim wb As Workbook, sht As Worksheet, shtC As Worksheet
    Dim c As Long, numRows As Long
    Dim map, colSrc As String, colDest As String
    Dim destRow As Long

    Set wb = ActiveWorkbook

    On Error Resume Next
    Set shtC = wb.Worksheets(CONSOLIDATED)
    On Error GoTo 0

    If shtC Is Nothing Then
        Set shtC = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        shtC.Name = CONSOLIDATED
    End If

    destRow = 2

    'create 2-d array of source & dest columns A-->A, C-->B, D-->C
    map = [{"A","A";"C","B";"D","C"}]

    For Each sht In wb.Worksheets
        'edit: add the sheet names you want to exclude from copying here
        '...or switch it around to check for names you *want* to consolidate...
        If sht.Name <> CONSOLIDATED And sht.Name <> "Report" _
           And sht.Name <> "whatever" Then

            '# of data rows....
            numRows = sht.UsedRange.Rows.Count - 1

            For c = LBound(map, 1) To UBound(map, 1)

                colSrc = map(c, 1)
                colDest = map(c, 2)

                With sht
                    .Range(.Range(colSrc & "2"), .Range(colSrc & (numRows + 1))).Copy _
                          shtC.Range(colDest & destRow)
                End With
            Next c

            destRow = destRow + numRows

        End If
   Next sht

End Sub

子测试4（）
Const合并为String=“扁平贡献文件”
将wb作为工作簿，sht作为工作表，shtC作为工作表
尺寸c等于长，numRows等于长
暗贴图，colSrc为字符串，最冷为字符串
变暗，尽可能长
设置wb=ActiveWorkbook
出错时继续下一步
设置shtC=wb.工作表（合并）
错误转到0
如果shtC不算什么，那么
设置shtC=wb.Sheets.Add（后面：=wb.Sheets（wb.Sheets.Count））
shtC.Name=合并
如果结束
destRow=2
'创建源列和目标列A-->A，C-->B，d-->C的二维数组
map=[{“A”，“A”，“C”，“B”，“D”，“C”}]
对于wb.工作表中的每个sht
'编辑：在此处添加要从复制中排除的图纸名称
“…或将其切换以检查您*想要*合并的名称…”。。。
如果为合并的项目名称和项目名称“报告”_
然后叫“随便什么”
“#的数据行…”。。。。
numRows=sht.UsedRange.Rows.Count-1
对于c=LBound（映射，1）到UBound（映射，1）
colSrc=map（c，1）
最冷=地图（c，2）
用短发
.Range（.Range（colSrc&“2”），.Range（colSrc&（numRows+1））。复制_
shtC.范围（最冷和最冷）
以
下一个c
destRow=destRow+numRows
如果结束
下一步
端接头

你能试着更专注/具体一点吗。到目前为止你试过什么？你能给我们一个你试过的代码样本吗？出什么事了？明白了。对不起，斯图尔特。新的足够了。动态学习。因为数据是动态的，所以你应该这样做。您需要使用

.Find

查找包含标题的确切列。一旦知道了列，就得到它的最后一行，并在摘要表中复制范围。有关

的更多信息。查找
嘿，Siddharth，有许多列具有相同的名称。这是一个包含6个单独的“分区”工作表的工作簿。我不确定。在这种情况下，“查找”会起作用。Siddharth有一个观点，您提到每个选项卡（出于代码目的称为工作表）在不同的列中有不同的标题。您如何知道合并到一个工作表不会使列出错（因为它们有不同的标题）。哪些标题是一致的？在您回答后，我找到了方便查找最后一行的解决方案：
LastRow=Cells（Rows.Count，#）。End（xlUp）.Row
where
#

是您在循环中的列。Tim，这太棒了。看起来不错。我正要运行它，看看它是如何运行的。非常感谢。嘿，Tim，汇总电子表格的第一列非常棒。如果我想从源代码表中选取第2、3、4和5列，并将其粘贴到第2、3、4和5列中在总结表中，它将如何更改？我尝试复制上面的代码，并将案例更改为相关的列号，但它在代码中给出了“编译错误-当前范围内的复制错误”和“合并为字符串”。非常感谢您的帮助，并感谢到目前为止的大量帮助。我应该澄清一下。我找到了一种方法，使我需要的数据在所有源工作表的相同列中。我现在需要在摘要工作表中将这些数据复制并传递到一个“主”列中。到目前为止，您的代码已经非常有效地将每个源工作表的第一列复制到主工作表中，非常感谢，即使是这样。我正在尝试让它复制列从每张工作表中选择B并粘贴到主工作表中的B栏。C栏和D栏等也一样。嘿，时间，现在它将一张不相关的信息表粘贴到摘要工作表中。我将重新措辞上述内容，但我非常感谢，我摆脱了这里的束缚。我的电子表格也这样设置。这些是选项卡的名称。续工作表，验证，报告，演示，主文件，然后是第2页到第14页（含第14页）。我希望第8页到第13页中A、B、C、D、E等列中的信息进入第14页中各自的列。基本上，将第8-13页中的所有“列表”合并到第14页的一个长列表中。B、C、D、E等列也是如此。