Macro VBA - Extraction de données

Bonjour,

Etant novice en VBA, je viens solliciter votre aide pour la résolution d’un problème.

Dans le classeur ci-joint, je souhaiterais réaliser les opérations suivantes à l’aide d’une macro :

Dans ma feuille 1 (BDD) j’ai une base de données.

A partir de cette base de données, je souhaiterais afficher dans la feuille 2 (Résultats) - (sans filtres apparents) les lignes concernant les villes (colonne C) Paris, Lyon, Marseille et dont le nom de structure (colonne D) ne commence pas par un asterix (*). Sur cette nouvelle feuille, je souhaiterais également supprimer les colonnes E et G.

L’idée étant de pouvoir actualiser mon tableau (Feuille 2) chaque fois que ma BDD sera mise à jour en feuille 1 en exécutant une macro.

Merci d’avance .

A ce stade, mon code est le suivant :

Sub Résultats()

Sheets(1).Range("A4:G20").Copy Sheets(2).Range("A4")

Sheets(2).Range("A4:G20").AutoFilter Field:=3, Criteria1:=Array("Paris", "Lyon", "Marseille"), Operator:=xlFilterValues

Sheets(2).Range("A4:G20").AutoFilter Field:=4, Criteria1:="<>*~**"

Range("E:E,G:G").Delete Shift:=xlToLeft

End Sub

Bonjour,

Un test

Bonjour,

Merci pour ta réponse.

Pourrais-tu STP, commenter tes actions pas à pas afin que je puisse comprendre la logique de fonctionnement ?

Bien à toi.

Re,

Avec les commentaires

Super.

Merci beaucoup.

Bonjour mpp93, le forum,

Salut M12,

Une variante ....à tester....

Sub test()

    Dim tablo(), tabloR()
    Dim derlig As Long

    derlig = Sheets("Résultats").Range("A" & Rows.Count).End(xlUp).Row
     If derlig > 4 Then Sheets("Résultats").Range("A5:G" & derlig).ClearContents

     tablo = Range("A4").CurrentRegion

     k = 0
      For i = 1 To UBound(tablo, 1)
         ReDim Preserve tabloR(1 To 5, 1 To k + 1)
          If tablo(i, 3) = "Paris" Or tablo(i, 3) = "Marseille" Or tablo(i, 3) = "Lyon" Then
           If Left(tablo(i, 4), 1) <> "*" Then
            tabloR(1, k + 1) = tablo(i, 1)
            tabloR(2, k + 1) = tablo(i, 2)
            tabloR(3, k + 1) = tablo(i, 3)
            tabloR(4, k + 1) = tablo(i, 4)
            tabloR(5, k + 1) = tablo(i, 6)
            k = k + 1
           End If
          End If
      Next i
       On Error Resume Next
        Sheets("Résultats").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(tabloR, 2), 5) = Application.Transpose(tabloR)
       Erase tabloR
       Sheets("Résultats").Activate
   End Sub

Cordialement,

Re,

Bonjour xorsankukai

Regarde seulement la première ligne du premier post après "Bonjour"

Je ne pense pas que pour débuter, ta macro (plus rapide sans doute) lui soit comprise

Re,

Bonjour xorsankukai

Regarde seulement la première ligne du premier post après "Bonjour"

Je ne pense pas que pour débuter, ta macro (plus rapide sans doute) lui soit comprise

Effectivement, tu as entièrement raison,

J'avais procédé de la même manière que toi dans un premier temps, puis comme je me fais toujours reprendre par les pros avec leur utilisation de "tablo", j'ai essayé d'optimiser....mais je reconnais que c'est très difficile à appréhender pour un novice (je ne maitrise pas complètement non plus, d'ailleurs ).

Amitiés,

Bonjour à tous les deux,

Merci pour vos retours.

Comme M12 l'a si bien dit, je ne suis encore qu'un novice. Toutefois, xorsankukai je serai intéressé par une petite explication de ton code. Dans la logique, tu n'es pas loin de M12 mais je constate quelques subtilités. Je suis preneur de quelques explications.

Bien à vous.

Re,

Merci pour ton retour,

J'ai essayé de rajouter des commentaires sur le fichier joint dans mon post précédent....mais comme je le disais, je ne maitrise pas complètement, pour des détails plus techniques, faudra solliciter d'autres membres plus expérimentés, je m'embrouille encore avec les redimensionnements des tableaux,

Pour le principe:

J'utilise 2 tableaux temporaires:

• tablo : qui reprend l'intégralité des données de la feuille BDD

• tabloR: qui reprend les données de tablo répondant aux 4 critères

On colle ensuite les données de tabloR dans la feuille Résultats (après avoir préalablement effacé les données existantes).

L'avantage des "tablo" est le gain de temps lors du traitement, surtout si tu as énormément de lignes à traiter, ce qui n'est pas probant dans cet exemple.

https://www.excel-pratique.com/fr/vba/tableaux_vba

Cordialement,

Re,

Finalement, je crois que je me suis un peu trop compliqué la vie,

En finalisant ta macro :

Option Compare Text

Sub Résultats()
 Dim derlig As Long
  derlig = Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row

  Application.ScreenUpdating = False

 Sheets("Resultats").Cells.ClearContents

 Sheets("BDD").Range("A4:G" & derlig).AutoFilter Field:=3, Criteria1:=Array("Paris", "Lyon", "Marseille"), Operator:=xlFilterValues
 Sheets("BDD").Range("A4:G" & derlig).AutoFilter Field:=4, Criteria1:="<>*~**"
 Sheets("BDD").Range("A4:G" & derlig).SpecialCells(xlVisible).Copy Sheets("Resultats").Range("A4")
 If Sheets("BDD").FilterMode = True Then Sheets("BDD").ShowAllData

 Sheets("Resultats").Range("E:E,G:G").Delete
End Sub

Sauf erreur de ma part, on obtient le même résultat....

Cordialement,