Macro de rapatriement de données sur critères

[jaba]

Bonjour,

je suis débutante en excel et VBA et je voudrais rapatrier des données dans un onglet en fonction d'un critère particulier.( et ce en appuyant sur un bouton)
Quelqu'un connait il un code pour le faire?

Ci dessous un fichier illustratif ooù je précise ce que je voudrais réaliser.

Merci beaucoup d'avance!

 

[Robert]

Re : Macro de rapatriement de données sur critères

Bonjour Jaba, bonjour le forum,

En pièce jointe ton fichier modifié avec un bouton Récup et une macro commentée.

 

[jaba]

Re : Macro de rapatriement de données sur critères

Bonjour Robert,

Merci pour ta macro, c'est exactement ce que je veux sauf que ça ne marche pas quand je veux l'appliquer à mon fichier.

Comment dois je faire pour la mettre dans mon fichier?
Faut il créer un bouton récup puis lui affecter la macro?ou est ce que la macro crée le bouton?

 

[Robert]

Re : Macro de rapatriement de données sur critères

Bonjour jaba, bonjour le forum,

J'ai utilisé un Bouton de Commande (CommandButton) de la barre d'outils Boîte à outils Contrôles. Soit tu fais la même chose, tu dessines le bouton, puis tu double-cliques dedans et tu copies entre les lignes :

Private Sub CommandButton1_Click()
 
End Sub

le code ci-dessous :

Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
ActiveCell.Select 'enlève le focus du bouton
With Sheets("Données") 'prend en compte l'onglet "Données"
    For Each cel In .Range("C2:C" & .Range("C65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées cel de la colonne C (en partant de C2)
        On Error Resume Next 'gestion des erreurs (si une erreur se produit, passe à la ligne suivante. Permet d'accepter "#N/A", "#DIV/0!", etc...)
        'condition : si la valeur de la cellule (en majuscule) n'est pas égale à "Satisfaisant" (permet d'accepter toutes les casses...)
        If Not UCase(cel.Value) = "SATISFAISANT" Then
            Set dest = Sheets("Result").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination
            .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 2)).Copy dest 'copie et colle les données correspondantes
        End If 'fin de la condition
    Next cel 'prochaine cellule cel de la boucle
End With 'fin de la prise en compte de l'onglet "Données

Soit tu recopies la macro ci-dessous dans un module. Tu crées une forme et tu lui affectes cette même macro.

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
ActiveCell.Select 'enlève le focus du bouton
With Sheets("Données") 'prend en compte l'onglet "Données"
    For Each cel In .Range("C2:C" & .Range("C65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées cel de la colonne C (en partant de C2)
        On Error Resume Next 'gestion des erreurs (si une erreur se produit, passe à la ligne suivante. Permet d'accepter "#N/A", "#DIV/0!", etc...)
        'condition : si la valeur de la cellule (en majuscule) n'est pas égale à "Satisfaisant" (permet d'accepter toutes les casses...)
        If Not UCase(cel.Value) = "SATISFAISANT" Then
            Set dest = Sheets("Result").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination
            .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 2)).Copy dest 'copie et colle les données correspondantes
        End If 'fin de la condition
    Next cel 'prochaine cellule cel de la boucle
End With 'fin de la prise en compte de l'onglet "Données
End Sub

 

[jaba]

Re : Macro de rapatriement de données sur critères

Merci beaucoup robert.
Bon dimanche.