Петля для копирования результатов отфильтрованного стола

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 

Существует ошибка:

Run-time error '1004': Select method of Range class failed

на второй инструкции цикла после первой итерации.

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