Sub Deplacer_paiement()
Dim Lig As Long, Col As String
Dim NbrLig As Long, NumLig As Long
Dim xRg As Range
Sheets("Dossiers clos").Activate
Col = "G"
NumLig = Cells(Rows.Count, 2).End(xlUp).Row
If NumLig < 7 Then NumLig = 6
With Sheets("Clients")
NbrLig = .Cells(.Rows.Count, Col).End(xlUp).Row
For Lig = 7 To NbrLig
If .Cells(Lig, Col).Value = "OUI" Then
NumLig = NumLig + 1
.Cells(Lig, Col).EntireRow.Copy Destination:=Sheets("Dossiers clos").Cells(NumLig, 1).EntireRow
End If
Next
NbrLig = .Cells(.Rows.Count, Col).End(xlUp).Row
For Lig = NbrLig To 7 Step -1
If .Cells(Lig, Col).Value = "OUI" Then
.Cells(Lig, Col).EntireRow.Delete
End If
Next
End With
Set xRg = Range(Cells(7, "B"), Cells(NumLig, "H"))
xRg.Sort key1:=xRg(1, 2), order1:=xlAscending, Header:=xlNo, _
key2:=xRg(1, 1), order2:=xlAscending
End Sub