Supprimer des lignes vides MAIS...

Sub test_clic()

aa = Range("A" & Rows.Count).End(xlUp).Row

u = 0
For i = 1 To aa
    If Range("A" & i) = "" Then
    u = u + 1
    Else
    u = 0
    End If
    If u > 1 Then
    MsgBox i
    Exit For
    Else
    End If
Next i

End Sub

Option Explicit

Dim sReference As String
Dim sNumeroAffaire As String

Dim i As Integer
Dim iDerniereLigne As Integer

Dim sVTE() As String

Sub Etude()

sNumeroAffaire = Application.InputBox("Entrez le numéro d'affaire", "Demande de numéro d'affaire", "SY01683")

iDerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
    
    With ThisWorkbook.Sheets(1)
        For i = 1 To iDerniereLigne
                sReference = .Cells(i, 1).Value
            If Left(sReference, 7) = sNumeroAffaire Then
                ReDim Preserve sVTE(1 To 2, 1 To i)
                sVTE(1, i) = .Cells(i, 1).Value
                sVTE(2, i) = .Cells(i, 2).Value
            End If
        Next i
        MsgBox "c'est fini"
    End With
End Sub