Suppression partielle

Bonjour à tous,

J'ai réalisé ma macro qui marcherait "presque" bien et je coince sur des lignes qui devraient être supprimées à la fin de l’exécution de la macro et qui persistent ligne 1371 et suivantes. Merci beaucoup pour vos explications.

Je vous joins mon fichier.

Voici ma macro:

Sub CLEANFICHIERPANTINROLO()

'

Application.ScreenUpdating = False

Sheets("PANTIN9902").Select

Cells.Select

Selection.EntireRow.Hidden = False

Cells.Select

Selection.Copy

Sheets("DESTRUCTION").Select

Cells.Select

Range("A1366").Activate

ActiveSheet.Paste

Application.CutCopyMode = False

Selection.AutoFilter

ActiveSheet.Range("$A$1:$IU$7001").AutoFilter Field:=1, Criteria1:=RGB(255 _

, 0, 0), Operator:=xlFilterFontColor

'suppression lignes cachées

Dim Lig As Long

For Lig = Range("A65536").End(xlUp).Row To 1 Step -1

If Rows(Lig).Hidden = True Then

Rows(Lig).Delete Shift:=xlUp

End If

Next Lig

ActiveCell.Cells.Select

Selection.AutoFilter

End Sub

Bonjour,

proposition de modification de ta macro, à tester

Sub CLEANFICHIERPANTINROLO()
'
' CLEANFICHIERPANTINROLO Macro
'

'
    Application.ScreenUpdating = False
    Sheets("DESTRUCTION").Rows.Delete
    With Sheets("PANTIN9902")
    .Rows.Hidden = False
    .Rows.Copy Sheets("DESTRUCTION").Range("a1")
    End With
    With Sheets("DESTRUCTION")
    .Cells.AutoFilter
    .Range("$A$1:$IU$7001").AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
    'suppression lignes cachées
    Dim Lig As Long
    For Lig = .Range("A65536").End(xlUp).Row To 1 Step -1
        If .Rows(Lig).Hidden = True Then
            .Rows(Lig).Delete Shift:=xlUp
        End If
    Next Lig

    .Cells.AutoFilter
    End With
End Sub

Bonjour h2so4,

J'ai testé ta macro, mais les lignes 1371 à 1578 persistent. Je ne comprends pas car la couleur de la police ne correspond pas à la condition et devrait normalement inclure ces lignes dans la catégorie à supprimer. Je ne suis pas assez avancé en vba pour voir si un autre angle de sélection possible pour arriver au résultat attendu. Merci d'avance, pour votre aide.

bonjour,

en corrigeant ton code, j'ai oublié l'essentiel. S'il y avait des lignes cachées après la dernière ligne visible celles-ci n'étaient pas effacées. essaie ceci.

Sub CLEANFICHIERPANTINROLO()
'
' CLEANFICHIERPANTINROLO Macro
'

'
   Application.ScreenUpdating = False
    Sheets("DESTRUCTION").Rows.Delete
    With Sheets("PANTIN9902")
    .Rows.Hidden = False
    .Rows.Copy Sheets("DESTRUCTION").Range("a1")
    End With
    With Sheets("DESTRUCTION")
     derlig = .Range("A65536").End(xlUp).Row ' dernière ligne avant application du filtre
    .Cells.AutoFilter
    .Range("$A$1:$IU$7001").AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
    'suppression lignes cachées
   Dim Lig As Long

    For Lig = derlig To 1 Step -1
        If .Rows(Lig).Hidden = True Then
            .Rows(Lig).Delete Shift:=xlUp
        End If
    Next Lig

    .Cells.AutoFilter
    End With
End Sub

Bonjour h2so4,

Effectivement, là se trouvait la solution! Je te remercie cela fonctionne parfaitement.

Un grand merci cela va me permettre de traiter un fichier bien compliqué...