Vba 基于另一列中的列表创建重复行

我在一张表中有一个项目编号列表，在另一张表中有一个组织编号列表。我想为每个组织编号复制每个项目编号行。它看起来是这样的：

开始项目表

PROJECT  EFF_DATE END_EFF_DATE DESCRIPTION
420000  1/11/2015   12/30/3000  Project 1  
420007  1/11/2015   12/30/3000  Project 2
420008  1/11/2015   12/30/3000  Project 3

Order Number
3710
3700
3715

起始订单编号表

PROJECT  EFF_DATE END_EFF_DATE DESCRIPTION
420000  1/11/2015   12/30/3000  Project 1  
420007  1/11/2015   12/30/3000  Project 2
420008  1/11/2015   12/30/3000  Project 3

Order Number
3710
3700
3715

运行宏/VBA后的结果表

PROJECT  EFF_DATE END_EFF_DATE DESCRIPTION  Order Number
420000  1/11/2015   12/30/3000  Project 1     3710
420007  1/11/2015   12/30/3000  Project 2     3710
420008  1/11/2015   12/30/3000  Project 3     3710
420000  1/11/2015   12/30/3000  Project 1     3700
420007  1/11/2015   12/30/3000  Project 2     3700
420008  1/11/2015   12/30/3000  Project 3     3700
420000  1/11/2015   12/30/3000  Project 1     3715
420007  1/11/2015   12/30/3000  Project 2     3715
420008  1/11/2015   12/30/3000  Project 3     3715

我曾尝试过使用宏和vba，但没有成功。有什么建议/想法吗？我想它是自动化的，如果可能的话，其结果是一个新的表，有排序的信息

---

谢谢

这是我目前得到的。如果您的两张工作表已排序，此代码将满足您的需要

但是，在第三张图纸上，您提供了一个标题行，就像在结果示例中一样

Sub sortProj()

    Dim i As Integer, j As Integer, z As Integer

    i = 2
    z = 2
    While ThisWorkbook.Sheets(2).Cells(i, 1) <> ""
        j = 2
        While ThisWorkbook.Sheets(1).Cells(j, 1) <> ""
            ThisWorkbook.Sheets(1).Cells(j, 1).EntireRow.Copy

            ThisWorkbook.Sheets(3).Cells(z, 1).Insert
            ThisWorkbook.Sheets(3).Cells(z, getEmptyCol) = ThisWorkbook.Sheets(2).Cells(i, 1)
            z = z + 1
            j = j + 1
        Wend
        i = i + 1
    Wend



End Sub

Function getEmptyCol() As Double

    Dim a As Integer
    a = 1
    While ThisWorkbook.Sheets(3).Cells(1, a) <> ""
        a = a + 1
    Wend

    getEmptyCol = a

End Function

Sub-sortProj（）
尺寸i为整数，j为整数，z为整数
i=2
z=2
而此工作簿.Sheets（2）.Cells（i，1）”中
j=2
而此工作簿.Sheets（1）.Cells（j，1）”
此工作簿.Sheets（1）.Cells（j，1）.EntireRow.Copy
此工作簿。工作表（3）。单元格（z，1）。插入
ThisWorkbook.Sheets（3）单元格（z，getEmptyCol）=ThisWorkbook.Sheets（2）单元格（i，1）
z=z+1
j=j+1
温德
i=i+1
温德
端接头
函数getEmptyCol（）为双精度
将a变暗为整数
a=1
而此工作簿.Sheets（3）.Cells（1，a）“”
a=a+1
温德
getEmptyCol=a
端函数

请对它的工作原理发表评论