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

我运行每周销售报告，并根据销售人员名称移动一些信息，然后生成多个报告。

我有代码排列销售人员姓名列“L”，删除重复的名称，并生成一个新的列，“P”。 然后创build新的图纸并将其命名为“P”。 这样，如果我有销售人员来来去去，我不必手动修改任何东西。

我目前正在过滤名称，并手动将行数据移动到其各自的工作表。 我需要的是：

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

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

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

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

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

希望下面的代码应该很好，如果不是，可能会有一些variables需要一些编辑。 请让我知道，如果它出错了，我可以帮你。 这里的假设是列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" 

Answer 2

我以大纲forms做的事情就是你所拥有的，然后在创build表单之后，在向下移动到下一个P2，P3等单元格之前，创build一个循环，从顶部到列L底部，如果L中的名称与单元格中的名称匹配，则取该行并将其复制到新创build的工作表中。

要做到这一点，你需要有一个RowCountervariables，无论你想填入新工作表的第一行是什么，并且每当你从你的“主表”复制一行到新创build的时候，这个variables就会增加一。 这是您的“目标”占位符。 它不是像列L上的循环一样，因为它们计算不同的东西。

看起来你在这里有一个好的开始， 将新代码放在两个Application.DisplayAlerts语句之间应该可以工作。

希望有所帮助; 至less应该让你朝着正确的方向前进。