Filtre données copier-coller par VBA

[Lex O'Mil]

J'ai déjà posté ce matin, néamoins l'urgence de l'info m'oblige à vous solliciter membre du forum.

En gros, j'ai quatre onglet dans un classeur. Un onglet qui contient mes graphiques et les 3 autres (voir plus) qui contiennent les données.

Sur le premier onglet une ligne qui sert de source à mes graphiques.
Sur ce même onglet j'ai deux combobox.
La combobox1 sélectionne un des 3 autres onglet
La combobox2 sélectionne les données de la première colonne de l'onglet préalablement sélectionné.

J'aimerais par le click sur une donnée de la combobox 2 qu'un filtre automatique soit fait sur l'onglet 2,3 ou 4 et que la ligne ainsi filtré soit copié puis coller sur l'onglet contenant mes greaphiques.

Je vous transmet le fichier.

S'il vous plait aidez-moi.

NB : de plus la combobox1 ne se rafraichit pas correctement??

 

[_Thierry]

Re : Filtre données copier-coller par VBA

Bonjour "Lex", le Forum

Je te conseillerai plutôt d'abandonner l'auto-filter pour une Boucle toute simple...

Re-voilà ton Module

Option Explicit
Private Sub Worksheet_Activate()
Dim vFEuille As Worksheet
ComboBox1.Clear
 
    For Each vFEuille In ActiveWorkbook.Sheets
            ComboBox1.AddItem vFEuille.Name
    Next
End Sub
Private Sub ComboBox1_Click()
Dim OngletBassin As String
    OngletBassin = ComboBox1.Value
    ComboBox2.ListFillRange = OngletBassin + "!A2:A4"
End Sub
 
Private Sub ComboBox2_Click()
Dim OngletBassin As String
Dim Rome As String
Dim Cell As Range
Dim CellCible As Range
Dim C As Byte
Set CellCible = ActiveSheet.Range("C45")
OngletBassin = ComboBox1.Value
Rome = ComboBox2.Value

For Each Cell In Sheets(OngletBassin).Range("A2:A4")
    If Cell = Rome Then
         For C = 0 To 30
            CellCible.Offset(0, C) = Cell.Offset(0, C)
         Exit For
         Next
    End If
Next Cell
End Sub

Bon Aprèm

@+Thierry
​

 

[Lex O'Mil]

Re : Filtre données copier-coller par VBA

Merci thierry déjà pour cette réponse néanmoins j'ai quelques questions :

Le module ne ramène que la donnée ROME hors j'aimerais que toute la ligne
de la cellule A2 à AE5 soit ramenée pour pouvoir mettre à jour mes graphiques et tableaux.
En fait il n'y a pas qu'une cellule cible mais une ligne cible

De plus, pourrais-tu m'expliquez la boucle car je serais amener à avoir plus que les 2 lignes dans chaque onglet.

En tout cas merci vraiment beaucoup d'avance.

Lex!

 

[_Thierry]

Re : Filtre données copier-coller par VBA

Re Bonsoir "Lex", le Forum

Oups y avait un petit bug... J'ai inserré un "Exit For" au mauvais endroit dans mon code précédent....

Du coup voici un code remanié qui se dimensionnera de manière dynamique sur les Plages de Cellules de chaque Onglet Bassin...

Option Explicit
Private Sub Worksheet_Activate()
Dim vFEuille As Worksheet
ComboBox1.Clear
 
    For Each vFEuille In ActiveWorkbook.Sheets
        If Not vFEuille.Name = ActiveSheet.Name Then
                ComboBox1.AddItem vFEuille.Name
        End If
    Next
End Sub
Private Sub ComboBox1_Click()
Dim OngletBassin As String
Dim PlageSource As Range
OngletBassin = ComboBox1.Value
With Sheets(OngletBassin)
    Set PlageSource = .Range(.Range("A2"), .Range("A1000").End(xlUp))
End With
    
    ComboBox2.ListFillRange = OngletBassin & "!" & PlageSource.Address(0, 0)
End Sub
 
Private Sub ComboBox2_Click()
Dim OngletBassin As String
Dim Rome As String
Dim PlageSource As Range, CellSource As Range
Dim CellCible As Range
Dim C As Byte
If ComboBox1.ListIndex = -1 Then Exit Sub
Set CellCible = ActiveSheet.Range("C45")
OngletBassin = ComboBox1.Value
Rome = ComboBox2.Value
With Sheets(OngletBassin)
    Set PlageSource = .Range(.Range("A2"), .Range("A1000").End(xlUp))
End With
For Each CellSource In PlageSource
    If CellSource = Rome Then
         For C = 0 To 30
            CellCible.Offset(0, C) = CellSource.Offset(0, C)
         Next
        Exit For
    End If
Next CellSource
End Sub

Pour la Boucle c'est assez simple, voici une "Explication de Texte"....

Private Sub ComboBox2_Click()
Dim OngletBassin As String
Dim Rome As String
Dim PlageSource As Range, CellSource As Range
Dim CellCible As Range
Dim C As Byte
 
[COLOR=green]'Si pas de sélection en ComboBox1 on Sort de la Macro[/COLOR]
If ComboBox1.ListIndex = -1 Then Exit Sub
 
[COLOR=green]'DEFINITION de la Première Cellule Cible
[/COLOR]Set CellCible = ActiveSheet.Range("C45")
 
OngletBassin = ComboBox1.Value
Rome = ComboBox2.Value
 
With Sheets(OngletBassin)
[COLOR=green]'DEFINITION DE LA PLAGE DYNAMIQUE[/COLOR]
    Set PlageSource = .Range(.Range("A2"), .Range("A1000").End(xlUp))
End With
 
 
[COLOR=green]'BOUCLE sur chaque cellule de la Plage Dynamique
[/COLOR]For Each CellSource In PlageSource

    [COLOR=green]'Si la Cellule = La Valeur recherchée...
[/COLOR]    If CellSource = Rome Then

         [COLOR=green]'Pour 31 Colonnes (de A2 à AE5)[/COLOR]
         For C = 0 To 30

           [COLOR=green] 'on envoie la valeur des cellules avec le décalage (Offset)
[/COLOR]            CellCible.Offset(0, C) = CellSource.Offset(0, C)
         Next

        [COLOR=green] 'Une fois qu'on a trouvé la PREMIERE valeur on sort de la boucle...
[/COLOR]        Exit For
    End If

Next CellSource[COLOR=green] 'On Continue si on a pas trouvé...
[/COLOR]End Sub

Bonne Soirée

@+Thierry
​

 

[Lex O'Mil]

Re : Filtre données copier-coller par VBA

Merci pour tout, cela fonctionne à la perfection.

Je tenais donc à le faire savoir, merci encore.

Lex.