Как объединить несколько столбцов в один столбец

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

Я ожидаю:

Мой вопрос заключается в том, как я могу скопировать имена людей, должность ицифры на основе столбца А?Заранее спасибо!