Discussion :

[fouggy]

Slt à tout le Forum,


Je viens de récupérer le code ci-dessous sur ce site.

J'ai su le modifier pour qu'il s'adapte à ma demande et cela marche très bien sur la feuille active.
Elle consiste à supprimer toutes les lignes dont les cellules de la colonne C ne contiennent pas la lettre "A", "M" ou "S".

Il faudrait simplement que ce code s'applique sur toutes les feuilles présentes dans le classeur et là je bloque un peu malgré les exemples qu'on peut aussi trouver ici.

Merci par avance de votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Test ()
 
Dim w As Range, derlig As Long, plage As Range
derlig = Range("C" & Rows.Count).End(xlUp).Row
For Each w In Range("C1:C" & derlig).Cells
  Select Case UCase(w.Text)
    Case "A", "M", "S"
    Case Else
      If plage Is Nothing Then
        Set plage = w
      Else
        Set plage = Application.Union(plage, w)
      End If
   End Select
Next
If Not plage Is Nothing Then plage.EntireRow.Delete
 
End Sub

[Patrice740]

Bonjour,

Essaies :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Public Sub Test()
Dim w As Worksheet
  For Each w In ThisWorkbook.Worksheets
    Call Remplacer(w)
  Next w
End Sub
Private Sub Remplacer(w As Worksheet)
 Dim c As Range
 Dim d As Long
 Dim r As Range
  d = w.Range("C" & w.Rows.Count).End(xlUp).Row
  For Each c In w.Range("C1:C" & d).Cells
    Select Case UCase(c.Text)
      Case "A", "M", "S"
      Case Else
        If r Is Nothing Then
          Set r = c
        Else
          Set r = Application.Union(r, c)
        End If
    End Select
  Next c
  If Not r Is Nothing Then r.EntireRow.Delete
End Sub

[fouggy]

Oupsssssss

Ca tourne en boucle sans que rien ne se passe... !

[Patrice740]

As-tu copié la macro dans un module standard du classeur concerné ?

[Theze]

Bonjour,

Je te propose un tout autre code (fonctionne à partir d'Excel 2007) qui utilise un filtrage avec un tableau de critères. Ce code est probablement plus rapide qu'une boucle sur un Range :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Sub Test()
 
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Tbl(1 To 3)
 
    For Each Fe In Worksheets 'toutes les feuilles
 
        Set Plage = DefPlage(Fe) 'appel de la fonction
 
        'tableau de critères (fonctionne qu'à partir d'Excel 2007 !)
        Tbl(1) = "A": Tbl(2) = "M": Tbl(3) = "S"
 
        With Plage
 
            .AutoFilter 3, Tbl, xlFilterValues 'filtre sur la colonne C (3)
            Fe.AutoFilter.Range.Copy Fe.Cells(Plage.Rows.Count + 1, 1)
            .AutoFilter 'supprime le filtrage
            Plage.Delete 'le résultat du filtrage collé sous la plage, supprime cette dernière
 
        End With
 
    Next Fe
 
End Sub
 
Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range
 
    On Error GoTo Fin
 
    With Fe
 
        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))
 
    End With
 
    Exit Function
 
Fin:
 
    Set DefPlage = Nothing
 
End Function

[fouggy]

Merci à vous pour votre aide.

Le code de Patrice740 fonctionne en effet lorsqu'on le place dans le module du fichier à traiter.

Le code de Theze est effectivement plus rapide.

Encore un grand merci à vous et surtout mes meilleurs voeux de santé et bonheur pour cette nouvelle année.