Sub Del_Shapka()
    Dim i, iCount
    iCount = Cells(Rows.Count, 5).End(xlUp).Row
  For i = iCount To 3 Step -1
   If Cells(i, 5) = "Логин" Then
      Rows(i).Delete shift:=xlUp
'      Del_Shapka
   End If
Next i
End Sub

Sub FindArea()
Dim name As String, x As Range, Adr&, kStr&, arr As Range, off&
name = Application.InputBox("Введите имя", "Имя продажника", "", 2)
Application.ScreenUpdating = 0
Set x = Columns(5).Find(name, , xlValues, xlWhole)
If Not x Is Nothing Then
    Adr = x.Row
    Do
        kStr = Cells(x.Row, 1).MergeArea.Count + 1
        Set arr = Cells(x.Row - 1, 1).Resize(kStr, 10)
        arr.Copy
        With Sheets(2).Range("D1").Offset(off)
            .PasteSpecial Paste:=xlPasteFormats
            .Resize(kStr, 10) = arr.Value
        End With
        Application.CutCopyMode = False
        off = off + kStr
        Set x = Columns(5).FindNext(x)
    Loop While Not x Is Nothing And Adr <> x.Row
End If
Application.ScreenUpdating = 1
End Sub