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

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

1 个答案: