Application Macro dans tout un classeur

Version imprimable

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:

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

Bonjour,

Essaies :

Code:

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

28/12/2018, 18h30
fouggy

Oupsssssss

Ca tourne en boucle sans que rien ne se passe... !
28/12/2018, 18h49
Patrice740

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

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:

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

01/01/2019, 14h00
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.