Sub wyszukaj()

    Dim zakres As Integer
    Dim w As Long
    zakres = 1

    With ActiveSheet
        LastRow = .UsedRange.Rows.Count
        For w = 2 To LastRow + 1
            If .Cells(w, 7).Value <> .Cells(w - 1, 7).Value Then
                .Range(.Cells(zakres, 1), .Cells(w - 1, 35)).Copy
                Sheets.Add
                Cells(2, 1).PasteSpecial
                ActiveSheet.Name = Cells(2, 7).Value
                zakres = w
            End If
        Next w
    End With
End Sub