VBA的Excel 2016粘贴表头从一列，进入一个新的表，基于另一列的值

Question

我有一个表，其中包含员工的分配：每列标题是他们的主管的姓名;行下面是分配给该人的雇员的名字。

例如，我的表约。宽12列，对于每个主管一列。约。 14行，每行包含分配给该主管雇员的姓名。

我需要将此信息转成第二个表：此表仅宽两列：列A包含了所有员工的列表，列B包含分配给他们的上司的名字。

目前我的代码工作，但我关心的是复制和粘贴从第一个表中的列标题到第二个表。我已经得到它的工作的唯一办法，就是使用基于行的第一个表中的号码预定范围内。如果我们添加/删除主管这可能是乏味的编辑。

我的问题是，我能避免使用“预定的范围”的复制/粘贴表头的需求？有基于A列一列的方式，我可以粘贴到新表（B列）？

• 因此，举例来说，如果在A列中雇员工程监理“约翰·史密斯”（和他的第一个表列中列出;工作表（“质量分配”）表2），我想贴头“约翰·史密斯”在他旁边的员工列。任何帮助/意见是极大的赞赏。

这里是我的代码：

' This is where J. Smith begins

    Worksheets("Employee Assignments").Range("Table2[John Smith]").Copy
With Worksheets("Supervisor Listing").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
End With
    Worksheets("Employee Assignments").Range("Table2[[#Headers],[John Smith]]").Copy
    Worksheets("Supervisor Listing").Select
    Range("B4:B17").Select
    ActiveSheet.Paste

' This is where J. Doe begins

    Worksheets("Employee Assignments").Range("Table2[Jane Doe]").Copy
With Worksheets("Supervisor Listing").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
End With
    Worksheets("Employee Assignments").Range("Table2[[#Headers],[Jane Doe]]").Copy
    Worksheets("Supervisor Listing").Select
    Range("B18:B31").Select
    ActiveSheet.Paste

Answer 1

你有没有使用指定范围与指数（）和匹配（）函数考虑？

命名范围将扩大到包括插入的列和行（或删除相同崩溃）。

指数和匹配是用于从表中提取数据属性，像你这里寻找伟大的功能。

Answer 2

你可以初始化范围变量来保存你的输出范围的开始

Dim oRng As Range

    Set oRng = Worksheets("Supervisor Listing").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

然后粘贴值后，确定你刚刚粘贴值的范围和粘贴就在旁边

    With Worksheets("Supervisor Listing")
        Worksheets("Employee Assignments").Range("Table2[[#Headers],[John Smith]]").Copy
        .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteValues
        .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteFormats
    End With

所以从你的榜样，你会得到

Dim oRng As Range

    Set oRng = Worksheets("Supervisor Listing").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    Worksheets("Employee Assignments").Range("Table2[John Smith]").Copy
    oRng.PasteSpecial xlPasteValues
    oRng.PasteSpecial xlPasteFormats

    With Worksheets("Supervisor Listing")
        Worksheets("Employee Assignments").Range("Table2[[#Headers],[John Smith]]").Copy
        .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteValues
        .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteFormats
    End With

    Set oRng = Worksheets("Supervisor Listing").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    Worksheets("Employee Assignments").Range("Table2[Jane Doe]").Copy
    oRng.PasteSpecial xlPasteValues
    oRng.PasteSpecial xlPasteFormats

    With Worksheets("Supervisor Listing")
        Worksheets("Employee Assignments").Range("Table2[[#Headers],[Jane Doe]]").Copy
        .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteValues
        .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteFormats
    End With

每次oRng被设定为之前的新的Employee值在"Supervisor Listing"片的1列中使用的最后一个单元格下面的单元被粘贴，然后oRng作为起始细胞引用和报头被直接粘贴到右侧相对于所述尺寸该范围只粘贴。

如果你想去你可以使用像一个更加动态路由

Dim oRng As Range
Dim t As ListObject
Dim h

    Set t = Worksheets("Employee Assignments").ListObjects("Table2")

    For Each h In t.HeaderRowRange
        Set oRng = Worksheets("Supervisor Listing").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Worksheets("Employee Assignments").Range("Table2[" & h.Value & "]").Copy
        oRng.PasteSpecial xlPasteValues
        oRng.PasteSpecial xlPasteFormats
        With Worksheets("Supervisor Listing")
            Worksheets("Employee Assignments").Range("Table2[[#Headers]," & h.Value & "]").Copy
            .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteValues
            .Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).PasteSpecial xlPasteFormats
        End With
    Next

这将通过你的表中的所有列循环，重复的复制和粘贴在你的表中的每个标题的行动。