Extraire les données d'un tableau dans une nouvelle feuille par critères

Bonjour,

J'ai un classeur Excel dont j'aimerais exporter certaines donnés en fonction de certain critères.

Dans ma colonne A j'ai le nom des ateliers. Ce que je veux c'est copier automatique sur une nouvelle feuille

les autres ligne du tableau en fonction du type d'atelier, J'ai trouver un code d'ont je me suis inspirer, le problème

est que au moment de la copie il n'y a que l'entête du tableau qui est copié dans la nouvelle feuille, j'ai essayé de modifier

le code, mais je ne trouve pas de solution et je ne comprends pas ce qui cloche. pourriez-vous m'aider s'il vous plaît ?

Merci !!!

Bonjour,

Une solution avec un filtre avancé :

Private Sub CommandButton1_Click()
Worksheets.Add Before:=Worksheets(1)
With Worksheets("Feuil2")
    .[K1] = Me.ComboBox1.Value
    .[A2].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.[K1], CopyToRange:=Worksheets(1).[A1]
    .[K1].ClearContents
End With
End Sub

Cdlt,

Edit : Si quelqu'un sait si l'on peut directement prendre la valeur de la combobox dans le criteriarange j'aimerai bien savoir !

Merci pour votre réponse, mais ce que j'aimerai c'est que si dans la zone de liste déroulante de ma UserForm je choisi un type d'atelier que toutes les ligne correspondantes à ce type d'atelier soient copié dans une nouvelle feuille Excel.

Exemple:

Si dans la zone de liste je sélectionne l'atelier "Méthodes de Maintenance", que toutes les lignes de la colonne A qui correspondent à "Méthodes de Maintenance" soient copiées et collées dans une nouvelle feuille Excel.

Bonjour,

Autant pour moi j'ai mal utilisé la propriété de filtre avancé, je voulais tester mais je n'ai pas regardé jusqu'à la fin du tableau. En effet elle n'est pas adptée.

Ci-contre une méthode qui fonctionne :

Private Sub CommandButton1_Click()
With Worksheets("Feuil2").[A2].CurrentRegion
    .AutoFilter 1, Me.ComboBox1.Value
    If .SpecialCells(xlCellTypeVisible).Rows.Count - 1 = 0 Then
        Worksheets("Feuil2").AutoFilterMode = False
        MsgBox "Aucune ligne à extraire", vbCritical
        Exit Sub
        Else
        .SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Feuil2").AutoFilterMode = False
        Worksheets.Add Before:=Worksheets(1)
        [A1].PasteSpecial
        Unload Me
        MsgBox "Sauvegarde terminée", vbInformation
    End If
End With
End Sub

Cdlt,

Merci ! J'ai testé le code, sa marche mais juste pour un seul type d'atelier "Méthodes de Maintenance", lorsque j'essaie avec une autre atelier le message "Aucune ligne à extraire" s'affiche à chaque fois et l'extraction n'est pas réalisée.

Cdlt,

Bonjour,

Désolé j'avais oublié un mot ... Mon erreur :

Private Sub CommandButton1_Click()
With Worksheets("Feuil2").[A2].CurrentRegion
    .AutoFilter 1, Me.ComboBox1.Value
    If .Offset(1).SpecialCells(xlCellTypeVisible).Rows.Count - 1 = 0 Then
        Worksheets("Feuil2").AutoFilterMode = False
        MsgBox "Aucune ligne à extraire", vbCritical
        Exit Sub
        Else
        .SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Feuil2").AutoFilterMode = False
        Worksheets.Add Before:=Worksheets(1)
        [A1].PasteSpecial
        Unload Me
        MsgBox "Sauvegarde terminée", vbInformation
    End If
End With
End Sub

Cette fois ci j'ai testé avec 4 ou 5 cas différents et ça devrait être OK !

Encore désolé !

Cdlt,

Merc ! ça marche super bien !

Bonjour,

J'ai encore quelque préoccupation qui sont:

1 - Si je veux non pas copier et coller dans une nouvelle feuille mais plutôt copier et coller dans une feuille connu,

j'ai ajouter au code le ligne en rouge (Destination:=Worksheets("Feuil10").Range("B1")) et j'ai supprimé les ligne en violet (Worksheets.Add Before:=Worksheets(1) [A1].PasteSpecial ), mais ça ne fonctionne plus.

2 - Lorsque j'essai d'appliquer le code à un autre Tableau quasiment identique (la différence est le nombre de colonne) à celle du test en modifiant le nom de la feuille dans le code (Worksheets("Feuil3")), Encore une fois sa ne marche que pour un seul atelier pour tous les autres j'ai le message d'erreur.

J'ai essayer de décortiquer le code je comprends toujours pas pourquoi ça ne marche pas pour un tableau différent

With Worksheets("Feuil2").[A2].CurrentRegion

.AutoFilter 1, Me.ComboBox1.Value

If .Offset(, 1).SpecialCells(xlCellTypeVisible).Rows.Count - 1 = 0 Then

Worksheets("Feuil2").AutoFilterMode = False

MsgBox "Aucune ligne à extraire", vbCritical

Exit Sub

Else

.SpecialCells(xlCellTypeVisible).Copy _

Destination:=Worksheets("Feuil10").Range("B1")

Worksheets("Feuil2").AutoFilterMode = False

Worksheets.Add Before:=Worksheets(1)

[A1].PasteSpecial

Unload Me

MsgBox "Sauvegarde terminée", vbInformation

End If

End With

Merci d'avance !

Pour une feuille existante :

Private Sub CommandButton1_Click()
With Worksheets("Feuil2").[A2].CurrentRegion 'Avec la plage contigüe à la feuille 2 cellule A2 (lignes et colonnes non vides)
    .AutoFilter 1, Me.ComboBox1.Value (filtre sur la 1ère colonne, valeur combobox 1)
    If .Offset(1).SpecialCells(xlCellTypeVisible).Rows.Count - 1 = 0 Then si décale d'une ligne à partir A2 et aucune ligne visible alors
        Worksheets("Feuil2").AutoFilterMode = False 'Désactive filtre
        MsgBox "Aucune ligne à extraire", vbCritical 'Message de sortie
        Exit Sub 'Sortie
        Else
        .SpecialCells(xlCellTypeVisible).Copy 'Copie les cellules visibles sur la plage
        Worksheets("Feuil10").[A1].PasteSpecial 'Colle en A1 feuille 10
        Worksheets("Feuil2").AutoFilterMode = False 'Retire filtre Feuille 2
        Unload Me 'Décharge USF
        MsgBox "Sauvegarde terminée", vbInformation 'Message confirmation
    End If
End With
End Sub

Pour votre second soucis peut importe le nombre de colonnes, je vous ai commenté le code pour vous aider.

A quelle ligne s'arrête l’exécution du code ? Sinon merci de joindre le fichier avec la manipulation que vous souhaitez réaliser.

Cdlt,

Bonjour !

Merci !

J'ai copier le code à l'identique mais ça ne marche pas je ne vois toujours pas mon erreur. Je vous laisse vérifier.

Cdlt

Bonjour,

Bon je coupe la poire en deux j'ai modifié la ligne de code pour vérifier s'il y a des lignes vides ou non, qui me semble plus simple :

Private Sub CommandButton2_Click()
With Worksheets("Feuil3")
    .[A2].CurrentRegion.AutoFilter 1, Me.ComboBox1.Value
    If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 = 0 Then
        .AutoFilterMode = False
        MsgBox "Aucune ligne à extraire", vbCritical
        Exit Sub
        Else
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Feuil10").[A1].PasteSpecial
        .AutoFilterMode = False
        Unload Me
        MsgBox "Sauvegarde terminée", vbInformation
    End If
End With
End Sub

Cdlt,

Merci !

ça marche super bien ! ça m'a beaucoup aidé que tu mettes un texte explicatif, pour savoir à quoi correspond chaque ligne du programme.

Je sais pas trop comment fonctionne le forum et je sui aussi novice sur Vba, alors j'aimerai savoir si, pour le même programme si je veux le modifier parce que j'ai une nouvelle idée qui me viens et que je n'y arrive, je pourrais toujours pauser la question ?

encore Merci ! Pour ton aide !

Cdlt

Bonjour,

Vous pouvez mais il vaut mieux ouvrir un sujet à chaque fois, ça aide à la lisibilité, et je ne suis pas certain de pouvoir répondre à toutes les requêtes.

Cdlt,

Bonjour,

Merci !

Cdlt

Bonjour,

Grâce à ton aide j'ai pu réussir à obtenir ce que je voulais. Encore Merci !

J'ai modifié ton code, je ne l'aie pas vraiment modifié j'y ai ajouté des choses, ce que j'ai fait c'est qu'en fonction du choix de l'atelier dans le menu déroulant, les valeur cellules correspondantes sont copiées et collées dans la feuille qui concerne l'atelier sélectionné.

Je te laisse regarder, si tu as une proposition pour le code soit moins long et volumineux, je suis tout ouïe.

Cdlt

voici le fichier

Bonjour,

En simplifié en passant par des tableaux qui permettent la correspondance valeur filtrée / feuille :

Private Sub CommandButton3_Click()
Dim i%
Dim WS() As Variant
Dim VAL() As Variant
WS = Array("Méthodes de Maintenance", "Garage", "Maintenance Genéral", "1er Transformation", "2ème Transformation", "3ème et 4ème Transformation")
VAL = Array("MMaint", "Garage", "MGen", "1erTrans", "2emeTrans", "3&4emeTrans")
For i = LBound(WS) To UBound(WS)
    If Me.ComboBox1.Value = WS(i) Then
        WS_DEST = VAL(i)
        Exit For
    End If
Next i
If WS_DEST = "" Then MsgBox "Atelier inexistant dans le tableau": Exit Sub
With Worksheets("Feuil3")
.[A2].CurrentRegion.AutoFilter 1, Me.ComboBox1.Value
    If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 = 0 Then
        .AutoFilterMode = False
        MsgBox "Aucune ligne à extraire", vbCritical
        Exit Sub
        Else
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
        Worksheets(WS_DEST).[A1].PasteSpecial
        .AutoFilterMode = False
        Unload Me
        MsgBox "Sauvegarde terminée", vbInformation
    End If
End With
End Sub

Cdlt,

MERCI !!!!

C'est vraiment beaucoup plus court et ca marche super bien !!!!!!

Désolé si c'est trop demandé, mais est ce que se serais possible d'avoir quelque explication sur les nouvelles ligne de code, je l'avoue je ne comprend pas bien la boucle au dessus de With .

Encore Merci !

Cdlt

Bonjour,

Le passage commenté :

WS = Array("Méthodes de Maintenance", "Garage", "Maintenance Genéral", "1er Transformation", "2ème Transformation", "3ème et 4ème Transformation") 'Définition des variables dans l'ordre dans le tableau WS
VAL = Array("MMaint", "Garage", "MGen", "1erTrans", "2emeTrans", "3&4emeTrans") 'Définition des variables dans le même ordre dans le tableau VAL
For i = LBound(WS) To UBound(WS) 'Boucle entre le plus petit index et le plus grand du tableau WS (donc i = 0 à 5 ici)
    If Me.ComboBox1.Value = WS(i) Then 'Quand la valeur de la combo box est rencontrée dans le tableau
        WS_DEST = VAL(i) 'Reprend l'indice i, regarde la valeur associée dans le tableau VAL et y place la valeur dans la variable WS_DEST
        Exit For 'Si pas rencontré alors continue
    End If
Next i 'Passe à la valeur suivante de i (donc valeur suivante du tableau WS
If WS_DEST = "" Then MsgBox "Atelier inexistant dans le tableau": Exit Sub ' Si WS_DEST est vide alors affiche message car valeur non trouvée dans WS.

Cdlt,