Sub Filtrowanie()

Dim wiersz_analizowany As Range
Dim imię As String
Dim nazwisko As String
Dim i As Long


Application.ScreenUpdating = False
    
Set wiersz_analizowany = Range(Cells(65536, "A").End(xlUp), _
                               Cells(65536, "A").End(xlUp).Offset(0, 6))
                                                              
    imię = wiersz_analizowany.Cells(1, 1).Value
nazwisko = wiersz_analizowany.Cells(1, 2).Value
                                   
Do While wiersz_analizowany.Row > 2
    Do While imię = wiersz_analizowany.Cells(1, 1).Offset(-1, 0).Value And _
         nazwisko = wiersz_analizowany.Cells(1, 1).Offset(-1, 1).Value
            For i = 3 To 7
                If wiersz_analizowany.Cells(1, i).Value <> "" Then
                   wiersz_analizowany.Cells(1, i).Cut
                   ActiveSheet.Paste wiersz_analizowany.Cells(0, i)
                End If
            Next i
         Set wiersz_analizowany = Range(wiersz_analizowany.Cells(1, 1).Offset(-1, 0), _
                                        wiersz_analizowany.Cells(1, 7).Offset(-1, 0))
         Rows(wiersz_analizowany.Cells(1, 1).Offset(1, 0).Row).Delete
    Loop
          Set wiersz_analizowany = Range(wiersz_analizowany.Cells(1, 1).Offset(-1, 0), _
                                         wiersz_analizowany.Cells(1, 7).Offset(-1, 0))
                                       
    imię = wiersz_analizowany.Cells(1, 1).Value
nazwisko = wiersz_analizowany.Cells(1, 2).Value
Loop

Application.ScreenUpdating = False
                              
End Sub