Excel VBA在单元格中搜索特定文本，然后复制到其他工作表

我想制作一个宏，从单元格

J5

复制

日期

，从单元格

H6

复制

发票号

，从合并单元格

A6

复制

消费者姓名

，并仅复制产品说明单元格范围（B11:B21）下的项目金额对于发票工作表中的项目，并按名称将这些值粘贴到另一张工作表发票记录中，有一个标题为<代码>消费者姓名、日期、发票号的表格。项目

（项目1、项目2、项目3、项目4、项目6、项目7、项目8、项目9、项目10、项目11、项目12的子标题）

我希望我的宏从发票工作表复制这些值，并粘贴到发票记录工作表表中每个值的标题下。为了更好地进行阐述，我提供了工作簿的链接：

https://www.dropbox.com/s/6wu69cgn3qfvr67/Invoice.xlsx?dl=0

---

首先，通过在开始处设置值来移动已知移动的数据。
棘手的部分是检查每个项目

因为您知道其中有12个，只要您提供的示例是如何布置的，您只需循环计算12个，并对每个项目将发票中的项目与产品编号进行比较，如果发票上有，则将在目标工作表的相应列中进行设置

已测试：使用示例表，请参见屏幕截图

Sub InvoiceRecord()

Dim source As String
Dim target As String
Dim tempCode As String
Dim tempItem As String
Dim prodCode As String
Dim count As Long
Dim lCol As Long
Dim tRow As Long
Dim lastTRow As Long

    source = "Invoice"
    target = "Invoice-Record"

    lastTRow = Sheets(target).Range("A" & Rows.count).End(xlUp).Row
    tRow = lastTRow + 1    'New row on target Sheet

    'Move the General Invoice Info over to Target
    Sheets(target).Cells(tRow, "A") = Sheets(source).Range("A6").Value  'Consumer
    Sheets(target).Cells(tRow, "B") = Sheets(source).Range("J5").Value  'Date
    Sheets(target).Cells(tRow, "C") = Sheets(source).Range("H6").Value  'Invoice No
    Sheets(target).Cells(tRow, "P") = Sheets(source).Range("J23").Value 'Net Amount

    'Now establish which Items have to move over

    For count = 1 To 12         'Looking for each of the 12 Items

        prodCode = "i" & count  'Set a Product Code based on "i"n  n = count
        lCol = count + 3        'The column number is 3 more than ProductCode Number

        For lRow = 11 To 22     'Loop through each row on the Source
            If Sheets(source).Cells(lRow, "A").Value > 0 Then
                tempCode = Sheets(source).Cells(lRow, "C").Value    'Get temp product code for row

                If tempCode = prodCode Then    'Insert the Qty in the Column for that item
                    Sheets(target).Cells(tRow, lCol) = Sheets(source).Cells(lRow, "A")
                End If
            End If
        Next lRow
    Next count
End Sub