'=====================
Sub DepLigneCouleur()
Dim cel As Range 'd?clare la variable cel (CELlule)
Dim dercel As Range 'd?clare la variable dest (DESTination)
Dim dl As Long 'd?clare la variable dl (Derni?re Ligne)
Dim x As Long 'd?clare la variable x
'If MsgBox("1.Contr?le cellule I et J, doit ?tre vide. 2.Transf?rer des lignes seulement en rouge...", vbQuestion + vbYesNo) = vbYes Then
If MsgBox("Contr?le cellule I et J, doit ?tre vide..." & " " & "Transf?rer des lignes seulement en rouge...", vbQuestion + vbYesNo) = vbYes Then
Application.ScreenUpdating = False 'masque les changements ? l'?cran
With Sheets("FactureOuverte") 'prend en compte l'onglet "FactureOuverte"
dl = .Range("A65536").End(xlUp).Row 'd?finit la variable dl
'------------- boucle invers?e sur toutes les cellules ?dit?es de la colonne A (de la derni?re ? la premi?re)
For Each cel In .Range("A2:A" & dl)
'------------- condition 1 : si la couleur de la cellule est rouge
If cel.Font.ColorIndex = 3 Then 'rouge
Set dercel = Sheets("FacturePay?").Range("A65536").End(xlUp)
cel.EntireRow.Cut dercel(2) 'coupe et colle la ligne
dercel(2).Resize(1, 8).Value = dercel(2).Resize(1, 8).Value 'Supprime les formules jusqu'? colonne 9
dercel(2).Resize(1, 8).Validation.Delete 'Supprime les validations jusqu'? colonne 9
End If
Next cel
'----------- boucle invers?e sur toutes les cellules ?dit?es de la colonne A (de la derni?re ? la premi?re)
For x = dl To 2 Step -1
'----------- condition 1 : si cellule est vide
If .Cells(x, 1).Value = "" Then
.Rows(x).Delete Shift:=xlShiftUp 'Supprime la ligne
End If
Next x
End With
'----------- Application.ScreenUpdating = True 'affiche les changements ? l'?cran
'----------- Trie la feuil2 de A ? Z
Range("A2:H65536").Select
ActiveWorkbook.Worksheets("FacturePay?").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("FacturePay?").Sort.SortFields.Add Key:=Range("F2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("FacturePay?").Sort
.SetRange Range("A2:H65536")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("FacturePay?").Activate
Sheets("FacturePay?").Range("A1").Select
Sheets("FactureOuverte").Activate
Range("B1").Select
End If
Application.ScreenUpdating = True
End Sub
'===================
