如何将多列合并为一列

Question

我是VBA的新学员。我将为这种形式的摘要表：

最终，该工作簿将具有120多个表单，我想使用VBA循环所有表单，然后在同一工作簿中为它们创建摘要表。所有表格的格式都与图片显示的格式相同。

这是我做的一个例子：

我现在拥有的非常复杂的代码（我从他人的帮助中合并了以下代码）：

Sub extractdata()
Dim ws As Worksheet
Application.ScreenUpdating = False
'GET BASIC DATA FROM THE SHEET
For Each ws In Worksheets
       If ws.Name Like "*" & "FormB" Then
            'Get the duplicated number of people and tasks:
            'G2=COUNTA(B2:F2);H2=COUNTA(A4:A7);I2=G2*H2
            ws.Range("G2:I5").Copy 
            Worksheets("Summary").Cells(Rows.Count, "O").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            ws.Range("A4:A6").Copy 'Get the task description
            Worksheets("Summary").Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            ws.Range("B2:F7").Copy 'Get the people's information
            Worksheets("Summary").Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        End If
        Next ws

End Sub

Sub Duplicate1()
Application.ScreenUpdating = False
'DUPLICATE THE ROW "O" BASED ON THE DUPLICATED TIMES 2(ColP)
Dim CurrentRow As Long
Dim currentNewSheetRow As Long: currentNewSheetRow = 1
Sheets("Summary").Activate
For CurrentRow = 2 To 20000
Dim timesToDuplicate As Integer
timesToDuplicate = CInt(Worksheets("Summary").Range("P" & CurrentRow).Value) 'THE DUPLICATED TIMES 2
Dim i As Integer
For i = 1 To timesToDuplicate
    With Worksheets("Summary")
    .Range("R" & currentNewSheetRow).Offset(1, 0).Value = Worksheets("Summary").Range("O" & CurrentRow).Value
     End With
    currentNewSheetRow = currentNewSheetRow + 1
    Next i
Next CurrentRow
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Sub Duplicate2()
Application.ScreenUpdating = False
'DUPLICATE THE ROW "H" BASED ON THE DUPLICATED TIMES 4(ColR)
Dim CurrentRow As Long
Dim currentNewSheetRow As Long: currentNewSheetRow = 1
Sheets("Summary").Activate
For CurrentRow = 2 To 20000
Dim timesToDuplicate As Integer
timesToDuplicate = CInt(Worksheets("Summary").Range("R" & CurrentRow).Value) 'THE DUPLICATED TIMES 4
Dim i As Integer
For i = 1 To timesToDuplicate
    With Worksheets("Summary")
    .Range("A" & currentNewSheetRow).Offset(1, 0).Value = Worksheets("Summary").Range("H" & CurrentRow).Value 'GET THE OUTCOME1 (ColA)
    End With
    currentNewSheetRow = currentNewSheetRow + 1
    Next i
Next CurrentRow
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

我期望的是：

我的问题是如何根据A列复制粘贴人员的姓名，职位和数字？预先谢谢你！