XL 2019 Faire une boucle avec plusieurs constante pour éviter de répéter le code

desmonts

XLDnaute Occasionnel
Bonjour à Toutes et tous,

je cherche une astuce pour le pas répéter le code donc faire une boucle en déclarant des constantes. Pour l'exempele ici mes cste sont RBEI et RFRV

Par avance merci.
VB:
Sub essai2()

Dim Pligvide As Long
'Code avec RBEI
Sheets("1").Select
Range("A1").AutoFilter Field:=1, Criteria1:="RBEI"
Sheets("feuil1").Select
Pligvide = Range("A" & Rows.Count).End(xlUp).Row + 1
    
Sheets("1").Rows("2:" & Application.Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("feuil1").Range("A" & Pligvide)

'Recopie du code ci-dessus avec la variable RFRV
Sheets("1").Select
Range("A1").AutoFilter Field:=1, Criteria1:="RFRV"
Sheets("feuil1").Select
Pligvide = Range("A" & Rows.Count).End(xlUp).Row + 1
    
Sheets("1").Rows("2:" & Application.Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("feuil1").Range("A" & Pligvide)

End Sub

bonne journée
 

pierrejean

XLDnaute Barbatruc
Bonjour desmonts

Edit: Salut Paf

A tester:
VB:
Sub essai2()
Dim Pligvide As Long
Codes = Array("RBEI", "RFRV") ' il est possible d'ajouter autant de codes que voulu
For n = LBound(Codes) To UBound(Codes)
Sheets("1").Range("A1").AutoFilter Field:=1, Criteria1:=Codes(n)
Pligvide = Sheets("feuil1").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("1").Rows("2:" & Application.Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("feuil1").Range("A" & Pligvide)
Next
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Pourquoi ne pas simplement utiliser le filtre élaboré?
(manuellement ou par macro)
Ci-dessous par macro
VB:
Sub Macro1()
'ajout pour RAZ
Feuil1.Columns("C:G").Clear
'///////////////////////////////////////////////
' Macro enregistrée le 25/07/2019 par STAPLE1600
Sheets("1").Range("A1:C40").AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Range("A1:A3"), _
    CopyToRange:=Range("C1"), Unique:=False
'///////////////////////////////////////////////
    'ajout pour esthétique
    [C1].CurrentRegion.Columns.AutoFit
End Sub
Et le résultat obtenu par la macro ( sur la feuille 1)
01FFILELA.jpg

NB: En jaune, les critères du filtre élaboré
Attention, c'est la feuille Feuil1 qui doit être la feuille active quand on lance la macro.
 

Discussions similaires

Réponses
2
Affichages
111

Statistiques des forums

Discussions
312 110
Messages
2 085 388
Membres
102 882
dernier inscrit
Sultan94