Sub traite()
For n = 1 To Range("A65536").End(xlUp).Row
If Left(Range("A" & n), 3) = "AAA" Then
Cells(n - 1, 2) = Range("A" & n)
Range("A" & n) = ""
End If
Next n
For n = Range("A65536").End(xlUp).Row To 1 Step -1
If Range("A" & n) & Range("B" & n) = "" Then Rows(n).Delete
Next n
For n = 1 To Range("A65536").End(xlUp).Row
If Range("A" & n) = "" Then Range("A" & n) = Range("A" & n - 1)
Next n
End Sub