probleme vba création liste selon 2 criteres dans nouvel onglet - code de JOB75

[slaurent01]

Bonjour à tous,

J'ai trouvé il y a quelques jours un excellent code vba de JOB75 qui permet d'extraire des données de différents onglets selon des critères et de les synthétiser dans un dernier onglet.

Sub Regroupe()
 Dim lig&, w As Worksheet, r As Range, v1, v2$
 Application.ScreenUpdating = False
 With Sheets("Regroupe") 'nom à adapter
   .Rows("4:" & .Rows.Count).Clear 'RAZ
   lig = 4 '1ère ligne renseignée
   For Each w In Worksheets
     If w.Name <> .Name Then
       For Each r In w.UsedRange.Rows
         v1 = Intersect(r.EntireRow, w.[F:F])
         v2 = Intersect(r.EntireRow, w.[L:L]).Text
         If IsDate(v1) Then
           If v1 >= Date And v2 = "" Then
             r.EntireRow.Copy .Cells(lig, 1)
             lig = lig + 1
           End If
         End If
       Next
     End If
   Next
   '.Columns.AutoFit 'ajustement automatique
   '.Activate 'facultatif
 End With
 End Sub

J'ai voulu testé et adapter ce code, car je pourrais en avoir besoin dans certaines de mes applications, cependant lorsque j'exécute la macro, si j'ai 3 onglets il me répète 3 fois les en-têtes de colonnes.

Je comprends pas pourquoi ca ne fonctionne pas correctement sur mon exemple. je demande donc votre aide et notamment à JOB75.

Par avance merci
bonne journée à tous
Stéphane

 

[pierrejean]

Re : probleme vba création liste selon 2 criteres dans nouvel onglet - code de JOB75

Bonjour slaurent101

En l'absence de mon ami Job un infâme bricolage qui n'a que le seul mérite de donner un resultat

Sub Regroupe()
 Dim lig&, w As Worksheet, r As Range, v1, v2$
 Application.ScreenUpdating = False
 With Sheets("Regroupe") 'nom à adapter
   .Rows("4:" & .Rows.Count).Clear 'RAZ
   lig = 4 '1ère ligne renseignée
   l_en_tete = lig - 1
   For Each w In Worksheets
     If w.Name <> .Name Then
       For Each r In w.UsedRange.Rows
         v1 = Intersect(r.EntireRow, w.[b:b])
         v2 = Intersect(r.EntireRow, w.[c:c])
           If v1 <> "" And v2 <> "" And v1 <> Sheets("Regroupe").Cells(l_en_tete, 2) Then
             r.EntireRow.Copy .Cells(lig, 1)
             lig = lig + 1
           End If
       Next
     End If
   Next
 End With
 End Sub

 

[slaurent01]

Re : probleme vba création liste selon 2 criteres dans nouvel onglet - code de JOB75

Bonjour le forum,

bonjour PierreJean, un grand merci pour votre réponse et pour avoir solutionné ce problème.
Ce code est vraiment excellent et très utile pour effectuer des sélections.

Par contre je ne comprends pourquoi ca ne fonctionnait pas auparavant, est ce que vous pouvez m'expliquer, svp, le code que vous avez rajouté pour que ca marche correctement?

cordialement
stéphane

 

[pierrejean]

Re : probleme vba création liste selon 2 criteres dans nouvel onglet - code de JOB75

Re

Ligne modifiée:

If v1 <> "" And v2 <> "" And v1 <> Sheets("Regroupe").Cells(l_en_tete, 2) Then

cet ajout évite la recopie de ligne si dans la ligne en cours apparaît l'en_tete de la colonne B

 

[slaurent01]

Re : probleme vba création liste selon 2 criteres dans nouvel onglet - code de JOB75

Re

Merci pour votre explication, j'en ai compris le principe.
Bonne fin de journée;

Cordialement
Stéphane