基於一個單元格值復制行並引用另一個單元格值並粘貼到新工作表上

Question

我必須創建一個報告，在其中我獲得帶有事務列表的原始數據，我需要我的宏根據C列中的項目組合名稱將每個事務發送到其各自的表

我這樣做了，但現在我需要從下面給出的參考表中的“現金”下的諾基亞交易，粘貼在“諾基亞 - 現金”表下

有人可以幫我構建我的代碼的第二部分，這有助於移動if C = Nokia和J = Semi Paid然后轉移到Nokia - Cash？

Answer 1

它類似於我之前回答的問題。

您不必擔心創建工作表並命名它們，代碼會處理它。 它還會跳過參考表中未找到的項目。

它將描述項與參考表中的項匹配，然后將卡名稱與匹配項的類別名稱進行聯合 ，以便命名相關表。 如果此工作表不存在，則會創建並傳遞行數據，否則只需傳遞行數據。

Sub MyClients()
Dim lastrow As Long, lastcol As Long, matchrow As Long, i As Long, j As Long
Dim wsname As String
lastrow = Worksheets("Raw").Cells(Worksheets("Raw").Rows.Count, 1).End(xlUp).Row
lastcol = Worksheets("Raw").Cells(1, Worksheets("Raw").Columns.Count).End(xlToLeft).Column

Application.ScreenUpdating = False
For i = 2 To lastrow
    On Error Resume Next
    matchrow = Application.WorksheetFunction.Match(Worksheets("Raw").Cells(i, 10).Value, Worksheets("Reference").Range("A:A"), 0)
    If Err.Number = 1004 Then
        MsgBox "Couldn't find item: '" & Worksheets("Raw").Cells(i, 10).Value & "' within reference sheet. Skipping row no: " & i
        GoTo skip:
    End If
    wsname = Worksheets("Raw").Cells(i, 3).Value & " - " & Worksheets("Reference").Cells(matchrow, 2).Value
    On Error Resume Next
    Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(1, 0) = Worksheets("Raw").Cells(i, 1).Value
    For j = 1 To lastcol - 1
        Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(0, j) = Worksheets("Raw").Cells(i, j).Value
    Next j
    If Err.Number = 9 Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = wsname
        For j = 1 To lastcol
            Worksheets(wsname).Cells(1, j) = Worksheets("Raw").Cells(1, j).Value
        Next j
        Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(1, 0) = Worksheets("Raw").Cells(i, 1).Value
        For j = 1 To lastcol - 1
            Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(0, j) = Worksheets("Raw").Cells(i, j).Value
        Next j
    End If
skip:
Next i
Worksheets("Raw").Activate
Application.ScreenUpdating = True
End Sub