=ФИЛЬТР('Рабочий проэкт'!A2:G6;'Рабочий проэкт'!D2:D6="Степаныч")

Sub mrshkei()
Dim sh As Worksheet, sh2 As Worksheet, rng As Range
Dim i As Long, n As Long, lr As Long, col As New Collection
Set sh = Worksheets("Рабочий проэкт")
With sh
On Error Resume Next
.ShowAllData
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
        On Error Resume Next
        col.Add .Cells(i, 4), CStr(.Cells(i, 4))
    Next i
    For i = 1 To col.Count
        For n = 1 To Sheets.Count
        If Worksheets(n).Name = col(i) Then
            Worksheets(n).Cells.Clear
            .Range("$A$1:$G$" & lr).AutoFilter Field:=4, Criteria1:=col(i)
            Set rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
            rng.Copy Destination:=Worksheets(n).Cells(1, 1)
        End If
        Next n
    Next i
End With
End Sub