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

我必须创build一个报告，其中包含交易清单的原始数据，我需要我的macros将每笔交易发送到各自的工作表，基于C列的投资组合名称

我pipe理这样做，但现在我需要从下面给出的参考表中的“现金”下的诺基亚交易，贴上“诺基亚 – 现金”

有人可以帮我build立我的代码的第二部分，这有助于移动如果C =诺基亚和J =半支付然后移动到诺基亚 – 现金？

Answer 1

这与我以前回答的问题类似。

您不必担心创build表单并命名它们，代码处理它。 它也会跳过参考表中找不到的项目。

它将描述项目与参考表中的项目进行匹配，然后将卡片名称与匹配项目的类别名称连接起来 ，以命名相关工作表。 如果该表不存在，则创build并传递行数据，否则只传递行数据。

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