Question

这里的第一个问题和融化我的大脑的问题。

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

我想将这些合并到一个长列表中。

例如：

我希望VBA将tab1中A列的信息复制到tab7（摘要标签）中的A列，然后将tab2中A列的信息复制到tab7中A列的NEXT BLANK CELL，依此类推等等其余的分区标签。

最后，我想留下一份我需要的所有信息的完整列表。我希望能够每个月运行一个宏来节省浪费复制和粘贴的时间。

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

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

Answer 1

如果您只复制每张工作表中的一列，并且该列位于每个不同的工作表上的固定位置：

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

编辑：如果每个源表的源列和目标列相同，那么这样的东西应该有效。注意：每个源表必须在Row1

中包含标题

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

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

1 个答案: