循环复制过滤表的结果

我正在制定一个工作时间表,在那里我每天都有一个员工名单和一张平板电脑的名单。 我的macros应该为每个员工过滤数据,将其复制并粘贴到新名单中。

Sub EnvoiPlanning() 'Sheets("People").Range("B:B").RemoveDuplicates Columns:=1, Header:= _ xlYes Dim i As Integer i = 2 While Sheets("People").Cells(i, 1) <> "" Sheets("Data").Range("A:O").AutoFilter Field:=2, Criteria1:=Sheets("People").Cells(i, 1).Value Sheets("Data").Range("A:F").Select Selection.Copy Sheets.Add After:=Sheets(Sheets.Count) Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(Sheets.Count).Name = Sheets("People").Cells(2, 1).Value i = i + 1 Wend End Sub 

有错误:

运行时错误“1004”:select范围类失败的方法

在第一次迭代之后循环的第二条指令。

例外截图

尝试这个 :

 Sub EnvoiPlanning() 'Sheets("People").Range("B:B").RemoveDuplicates Columns:=1, Header:= _ xlYes Dim i As Integer, _ Ws As Worksheet i = 2 While Sheets("People").Cells(i, 1) <> "" Sheets("Data").Range("A:O").AutoFilter Field:=2, Criteria1:=Sheets("People").Cells(i, 1).Value Sheets("Data").Range("A:F").Copy Set Ws = Sheets.Add(After:=Sheets(Sheets.Count)) Ws.Range("A1").PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False Ws.Name = Sheets("People").Cells(2, 1).Value i = i + 1 Wend End Sub