MONTREAL2020
XLDnaute Junior
Bonjour,
J'ai trouvé ce code VBA en ligne qui me permet de copier une plage de lignes dont la (K) contient un critère (OUT)
Une fois filtrée, la coller dans une autre feuille.
Objectifs:
- Exécuter la macro par un bouton qui se trouve dans une autre que la base et la feuille de destination
- Coller les lignes en valeurs
- Réduire le temps d'exécution, car celle que je vient de tester prend à peu près 13 à 15 secondes.
Merci par avance
Voici le code: je sais qu'il une meilleure façon de coller sur le corps de la discussion, mais je n'ai pas su le faire.
Option Explicit
Sub Copy_out_list()
Dim x As Long
Dim y As Long
Dim c As Range
Dim rdata As Range
x = Feuil11.Range("A65536").End(xlUp).Row
y = Feuil16.Range("A65536").End(xlUp).Row + 1
Set rdata = Feuil11.Range("K2:K" & x)
If y >= 2 Then Feuil16.Range("A2:k" & y).ClearContents
For Each c In rdata
If c.Value = Feuil16.Range("K1").Value Then
Feuil11.Range("A" & c.Row & ":K" & c.Row).Copy Destination:=Feuil16.Range("A" & y).
End If
y = Feuil16.Range("A65536").End(xlUp).Row + 1
Next c
End Sub
J'ai trouvé ce code VBA en ligne qui me permet de copier une plage de lignes dont la (K) contient un critère (OUT)
Une fois filtrée, la coller dans une autre feuille.
Objectifs:
- Exécuter la macro par un bouton qui se trouve dans une autre que la base et la feuille de destination
- Coller les lignes en valeurs
- Réduire le temps d'exécution, car celle que je vient de tester prend à peu près 13 à 15 secondes.
Merci par avance
Voici le code: je sais qu'il une meilleure façon de coller sur le corps de la discussion, mais je n'ai pas su le faire.
Option Explicit
Sub Copy_out_list()
Dim x As Long
Dim y As Long
Dim c As Range
Dim rdata As Range
x = Feuil11.Range("A65536").End(xlUp).Row
y = Feuil16.Range("A65536").End(xlUp).Row + 1
Set rdata = Feuil11.Range("K2:K" & x)
If y >= 2 Then Feuil16.Range("A2:k" & y).ClearContents
For Each c In rdata
If c.Value = Feuil16.Range("K1").Value Then
Feuil11.Range("A" & c.Row & ":K" & c.Row).Copy Destination:=Feuil16.Range("A" & y).
End If
y = Feuil16.Range("A65536").End(xlUp).Row + 1
Next c
End Sub