循环以复制过滤表的结果

Question

我正在制定一份工作时间表，其中列出了员工姓名和每个人每天安排的平面表。我的宏应该为每个员工过滤数据，复制并将其粘贴到一个带有他/她名字的新表中。

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'：选择Range类失败的方法

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

Answer 1

试试这个：

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