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

Question

我想制作一个宏来复制Date来自单元格J5，复制Invoice No.来自单元格H6，复制consumer name来自合并单元格{{1并且仅复制发票表中项目的产品说明单元格范围（B11：B21）下的项目数量，并按名称将这些值粘贴到另一个工作表中。发票 - 记录表格中包含标题A6

（Item1，Item2，Item3，Item4，Item6，Item7，Item8，Item9，Item10，Item11，Item12的Sub Headers）

我希望我的宏从发票工作表中复制这些值并粘贴在发票 - 记录表中表格中每个的标题下。为了更好地阐述它，我给出了工作簿的链接：

consumer name, date, Invoice No. Items

Answer 1

首先通过设置开头的值来移动您知道移动的数据 棘手的部分是检查每个项目。

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

TESTED：使用您的示例表，请参见屏幕截图。

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