基于一个单元格值复制行并引用另一个单元格值并粘贴到新工作表上

Question

I have to create a report where I get a raw data with a list of transactions, I need my macro to send each transaction to its respective sheets based on if Portfolio name at C Column

I manged to do that, but now I need Transaction of Nokia that fall under 'Cash' from the below given reference sheet, to paste under sheet "Nokia - Cash"

Can someone please help me build the 2nd part of my code which helps to move the if C=Nokia and J = Semi Paid then move to Nokia - Cash?

Answer 1

It is similar to the previous question I have answered.

You don't have to worry about creating the sheets and naming them, the code handles it. It also skips the items which are not found in reference sheet.

It matches the description item with item in your reference sheet , then concats card name with the matched item's category name in order to name the relevant sheet. If this sheet does not exist, it creates and pass the row data, otherwise simply pass the row data.

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