mise en forme d'un fichier

Sub MiseEnForme()
Dim DerLig As Long, Lig As Long, Adr3 As String, Adr4 As String
With Sheets("Extraction fichier Enyx")
  DerLig = .Range("B" & Rows.Count).End(xlUp).Row
  Lig = 1
  Do While Lig <= DerLig
    ' Un semblant d'adresse mail se ballade
    If InStr(1, .Range("A" & Lig), ".FR") > 0 Or _
      InStr(1, .Range("A" & Lig), ".COM") > 0 Then
      .Rows(Lig).Delete
    End If
    If .Range("A" & Lig) <> "" Then
      If .Range("A" & Lig + 1) <> "" Or .Range("B" & Lig + 1) <> "" Then
        .Range("C" & Lig) = .Range("A" & Lig + 1)
        .Range("D" & Lig) = .Range("B" & Lig + 1)
        .Rows(Lig + 1).Delete
      Else
        .Rows(Lig + 1).Delete
      End If
    Else
      .Rows(Lig).Delete
    End If
    If .Range("A" & Lig + 1) = "" And .Range("B" & Lig + 1) = "" Then
      .Rows(Lig + 1).Delete
      Lig = Lig + 1
    End If
    ' Récupérer la valeur de la dernière ligne
    DerLig = .Range("B" & Rows.Count).End(xlUp).Row
End With
End Sub