1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| Sub Transfert()
Dim LastLig As Long
Dim cDest As Range
Application.ScreenUpdating = False
With ThisWorkbook
'cDest: La celllule de destination: première cellule vide de la colonne A de Feuil2
With .Worksheets("archive")
Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
End With
With .Worksheets("Feuil1")
'Enlève l'éventuel filtre automatique
.AutoFilterMode = False
'LastLig, ligne de la dernière cellule remplie de colonne A de Feuil1
LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
'On fait un filtre automatique sur la colonne A de Feuil1 avec comme critère "x"
.Range("L1:L" & LastLig).AutoFilter field:=1, Criteria1:="fini"
'Si au moins une ligne résultat du filtre (en plus de la ligne 1 des titres)
If .Range("L1:L" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
With .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow
'On copie toutes les lignes visibles vers cDest (sauf la ligne des titres)
.Copy cDest
'on supprime toutes les lignes visibles (sauf la ligne des titres)
.Delete
End With
End If
'on vide notre variable cDest
Set cDest = Nothing
'On enlève le filtre automatique
.AutoFilterMode = False
End With
End With
End Sub |
Partager