根据单元格值将行从目标表复制到其他表

Question

我在（vba查找）问题上遇到了一些困难。

我有一个工作表（sheet3），其中有多行不同发票的数据（每行数据都包括与之相关的发票编号） 数据表

我已将唯一的发票号复制到单独的工作表中，每个发票都有自己的工作表，并且发票号在单元格B1中。 发票表

我要做的是将数据表中的所有行复制到具有匹配发票编号的表中。

我当前代码的全部内容就是我的单独发票页面链接，而不是使用Vba来创建它们，因为页面上还会有其他各种格式和格式，所以我几乎从零开始就开始了！

  Private Sub CommandButton1_Click()
     Dim s1 As Worksheet, s2 As Worksheet
     Set s1 = Sheets("sheet3")
     Set s2 = Sheets("Bill Date")
     s1.Range("F:G").Copy s2.Range("A:B")
     s2.Range("A:B").RemoveDuplicates Columns:=1, Header:=xlNo
  End Sub

您的帮助将不胜感激

谢谢

Answer 1

在您的VBA宏中，在for循环中执行以下操作：

Sub copyData()
    Dim invNo As String
    Dim lastRow As Integer
    Dim sourceSht As Worksheet
    Dim targSht As Worksheet

    Set sourceSht = Worksheets("Sheet3")

    'evaluates every data item from row 2 to last populated row
    For Row = 2 To sourceSht.Cells(sourceSht.Rows.Count, 1).End(xlUp).Row

        invNo = sourceSht.Range("F" & Row).Value

        'if invNo blank, skip
        If invNo <> "" Then
            'try to find the sheet, make if does not exist
            invNo = invNo & "_INV"
            On Error Resume Next
            Set targSht = Worksheets(invNo)
            If targSht Is Nothing Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = invNo
                Set targSht = Worksheets(invNo)
                'SetHeader
            End If

            'find first empty row in targSht
            lastRow = targSht.Cells(targSht.Rows.Count, 1).End(xlUp).Row + 1

            'copy row of data
            sourceSht.Range("A" & Row & ":L" & Row).Copy
            targSht.Range("A" & lastRow & ":L" & lastRow).Select
            targSht.Paste

            'must do to make more sheets
            Set targSht = Nothing
        End If
    Next
End Sub

我更改了您的某些规格，以便采用更简单的方法。 我以为您向我展示的十二列就足够了。 我在发票表的末尾添加了“ _INV”，因为纯粹的数字表名称可能会导致错误。 我还要逐行将数据行粘贴到新工作表中。 如果保留当前标题，则需要更改顺序。 您可以考虑更改targSht标头以使其更容易。 SetHeader是代码块的占位符，可根据需要在targSht中设置标题行。 如果可以解决您的问题，请标记为正确。

演示（无发票抬头）：