1つのセル値に基づいて行をコピーし、別のセル値を参照して新しいシートに貼り付けます。

Question

トランザクションのリストで未処理のデータを取得するレポートを作成する必要があります。 C列のポートフォリオ名を基にしたそれぞれのシート

私はこれを行うように指示しましたが、今はノキア - キャッシュの下に貼り付けるために、下の参照シートから '現金'

誰かが私のコードの2番目の部分を構築して、C = NokiaとJ = Semi PaidをNokia Cashに移行するのに役立つことができますか？

Answer 1

これは私が答えた前の質問に似ています。

シートの作成と名前付けに心配する必要はありません。コードはそれを処理します。また、リファレンスシートに記載されていない項目はスキップします。

それはあなたのリファレンスシートに項目と記述項目と一致し、その後、関連するシートに名前を付けるためにマッチしたアイテムのカテゴリ名でカード名をconcats。このシートが存在しない場合は、行データを作成して渡します。それ以外の場合は単純に行データを渡します。

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