当 L 列值与 P 列匹配时，VBA 将行复制到新电子表格

Question

我运行每周销售报告并根据销售人员姓名移动一些信息，这样我就可以生成多个报告。

我有代码对列“L”中的销售人员姓名进行排序，删除重复名称并生成一个新列“P”。然后它会创建新工作表并以“P”中的名称命名它们。这样，如果我有销售人员来来去去，我就不必手动修改任何东西。

我目前过滤名称并手动将行数据移动到各自的工作表中。我需要的是:

1-在 L 列中查找与“主名称列”单元格 P2 或 P3 或 P4 等匹配的所有名称。

2-将在 L 列中具有名称的所有行复制到同名的工作表中。工作表名称与 P 列中的名称相同。

3- 移动 P 列中的下一个名称，单元格 P3，然后再次开始匹配过程。 . .`

我附上了我用来从 P 列中的名称创建工作表的代码。

Dim newSheet As Worksheet, regionSheet As Worksheet
    Dim cell As Object
    Dim regionRange As String

    Set regionSheet = Sheets("EXPORT_QUERY")
    Application.ScreenUpdating = False

    regionRange = "P2:" & regionSheet.Range("P2").End(xlDown).Address

    For Each cell In regionSheet.Range(regionRange)
       If SheetExists(cell.Value) = False Then
          Sheets.Add After:=Sheets(Sheets.Count)
          Set newSheet = ActiveSheet
          newSheet.Name = cell.Value
          Application.DisplayAlerts = False
          Application.DisplayAlerts = True
       End If
    Next cell

   MsgBox "All worksheets have been created successfully"

   Application.ScreenUpdating = True

End Sub

Answer 1

希望下面的代码可以正常工作，否则可能会有一些变量需要进行一些编辑。如果它在某个地方出错，请告诉我，我可以帮你解决这个问题。这里的假设是列 P 仅包含唯一名称。

Set regionSheet = Sheets("EXPORT_QUERY")
regionRange = "P2:" & regionSheet.Range("P2").End(xlDown).Address


For Each cell In regionSheet.Range(regionRange)
    Range("A1:L" & Range("A" & rows.count).end(xlup).row).select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$L$" & Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=12, Criteria1:=cell.Value
    ActiveSheet.Range("$A$2:$L$" & Range("A" & Rows.Count).End(xlUp).Row).Copy

    Sheets(cell.Value).Select
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Select
    ActiveSheet.Paste
    Sheets("EXPORT_QUERY").select
    Selection.AutoFilter
Next cell

MsgBox DONE"