如何合并两个合并数据的工作表？

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