Erreur sur MACRO Excel -- suppression de ligne dans classeur

bonjour,

Je souhaite supprimer toutes les lignes de mes feuilles (colonne 1 - ID DEMANDE) de mon classeur dont la liste figure dans la feuille LIST ids

J'ai un bug avec cette macro, est ce que quelqu'un peut m'aider

Merci beaucoup

Je vous joints le fichier excel

Bonsoir chm92,

A toi de tester, étant sous Excel 2003, je ne peux point

Option Explicit
Sub test()
Dim ws As Worksheet, rngCrit As Range, vCrit
    Application.ScreenUpdating = False
    With Sheets("Liste IDs")
        Set rngCrit = .Range("A4:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    vCrit = rngCrit.Value
    For Each ws In Worksheets
        If Not ws Is Sheets("Liste IDs") Then
            With ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
                ws.AutoFilterMode = False
                .AutoFilter 1, Application.Transpose(vCrit), 7
                .Offset(1).EntireRow.Delete
                .AutoFilter
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Elle est où ta macro

klin89

Effectivement macro absente,

je vous renvoie le tableau

Merci pour votre aide

Bonjour,

La proposition de Klin89 ( ) me semblait tout à fait convenir (à un détail près : la suppression ne ciblant pas les cellules filtrées...) mais elle m'a fait planter Excel à répétition (divers essais d'aménagements qui n'ont pas été concluants, peut-être aurait-il fallu épurer le tableau de critères ?...), je me suis donc rabattu sur une autre méthode.

Sub SupprimIDs()
    Dim ws As Worksheet, lstP, d As Object, i%, n%
    Set d = CreateObject("Scripting.Dictionary")
    With [T_Liste_ID]
        If .Worksheet.FilterMode Then .Worksheet.ShowAllData
        lstP = .Value
    End With
    For i = 1 To UBound(lstP)
        d(lstP(i, 1)) = ""
    Next i
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Liste IDs"
            Case Else
                If ws.FilterMode Then ws.ShowAllData
                n = ws.Cells(Rows.Count, 1).End(xlUp).Row
                lstP = ws.Range("A1:A" & n).Value
                For i = 2 To n
                    If d.exists(lstP(i, 1)) Then lstP(i, 1) = Empty
                Next i
                With ws.Range("A1:A" & n)
                    .Value = lstP
                    On Error Resume Next
                    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                    On Error GoTo 0
                End With
        End Select
    Next ws
End Sub

Cordialement.

Re à tous,

J'ai pu tester mon code sur un autre poste

Pour l'exemple, j'ai remplacé :

.AutoFilter 1, Application.Transpose(vCrit), 7

par

.AutoFilter 1, Array("819", "817", "814"), 7

soit des éléments de type texte et cela fonctionne

klin89

re chm92,

Comme tes données sont numériques, ceci devrait le faire

Option Explicit
Sub test()
Dim ws As Worksheet, rngCrit As Range, vCrit, i As Long
    Application.ScreenUpdating = False
    With Sheets("Liste IDs")
        Set rngCrit = .Range("A4:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    vCrit = rngCrit.Value
    For i = 1 To UBound(vCrit, 1)
        vCrit(i, 1) = CStr(vCrit(i, 1))
    Next i
    For Each ws In Worksheets
        If Not ws Is Sheets("Liste IDs") Then
            With ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
                ws.AutoFilterMode = False
                .AutoFilter 1, Application.Transpose(vCrit), 7
                .Offset(1).EntireRow.Delete
                .AutoFilter
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

klin89