如何合併兩個合併數據的工作表？

Question

我有2個Excel工作表中的信息，我想將其合併到另一個工作表中，以便爲第一個工作表中的每個數據項添加第二個工作表中的所有數據行的副本。例如：

 
Sheet One 
    A 
Department 1 
Department 2 
Department 3 

---------------------------------------------- 

Sheet 2 
    F   G   H 
ItemCode1, ItemDesc1, ItemCost1 
ItemCode2, ItemDesc2, ItemCost2 
ItemCode3, ItemDesc3, ItemCost3 
ItemCode4, ItemDesc4, ItemCost4 
ItemCode5, ItemDesc5, ItemCost5 

---------------------------------------------- 

Resultant Sheet 3 
     A   F   G   H 
Department 1, ItemCode1, ItemDesc1, ItemCost1 
Department 1, ItemCode2, ItemDesc2, ItemCost2 
Department 1, ItemCode3, ItemDesc3, ItemCost3 
Department 1, ItemCode4, ItemDesc4, ItemCost4 
Department 1, ItemCode5, ItemDesc5, ItemCost5 
Department 2, ItemCode1, ItemDesc1, ItemCost1 
Department 2, ItemCode2, ItemDesc2, ItemCost2 
Department 2, ItemCode3, ItemDesc3, ItemCost3 
Department 2, ItemCode4, ItemDesc4, ItemCost4 
Department 2, ItemCode5, ItemDesc5, ItemCost5 
Department 3, ItemCode1, ItemDesc1, ItemCost1 
Department 3, ItemCode2, ItemDesc2, ItemCost2 
Department 3, ItemCode3, ItemDesc3, ItemCost3 
Department 3, ItemCode4, ItemDesc4, ItemCost4 
Department 3, ItemCode5, ItemDesc5, ItemCost5 

任何人都可以幫我解決這個問題嗎？到目前爲止，我試圖迭代構建新工作表的數據，但我認爲可能有更簡單的方法去實現它。

Answer 1

下面是上述的VBA代碼，分析代碼和跟蹤以便更好地理解。
以meachanical的方式完成（只需複製並粘貼）。
這可能會做得更好，但我的猜測是相當大的代碼。

Sub Macro1() 

Dim wkbk As Workbook 
Dim i As Integer 

Dim lastrow As Long 
Dim lastrow3 As Long 
Dim lastrowref As Long 

i = 1 

Set wkbk = ActiveWorkbook 

    Do 
     ' to find the range(used to paste values in sheet 3(Column A-Department1 
     'and cloumn B(for Values in sheet2) 
     lastrowref = lastrow3 + 1 

     With wkbk.Sheets(2).Select 
     Range("f1:H1").Select 
     Range(Selection, Selection.End(xlDown)).Select 

     Selection.Copy 
     End With 

     With wkbk.Sheets(3).Select 
     Cells(lastrowref, 6).Select 
     ActiveSheet.Paste 
     End With 

        With ActiveWorkbook.Sheets(3) 
' to find the cells where data needs to be pasted 
        lastrow3 = .Range("f1").End(xlDown).Row 
        End With 


        Sheets("Sheet1").Select 
        With ActiveWorkbook.Sheets(1) 
'to find the number of records in sheet1 
        lastrow = .Range("a1").End(xlDown).Row 
        End With 

        With ActiveWorkbook.Sheets(1) 
        .Cells(i, 1).Select 
        Selection.Copy 
        End With 

     With wkbk.Sheets(3).Select 
     Range(Cells(lastrow3, 1), Cells(lastrowref, 1)).Select 
     ActiveSheet.Paste 
     End With 
' loops till the Number of departments in sheet1 
       i = i + 1 
    Loop While i <= lastrow 


End Sub