Macro pour copier/coller selon critère

[penelope]

Bonjour à tous,
Je suis en train de me créer un petit programme pour le suivi des résultats des chevaux d'une écurie de course... Et je bloque complétement sur l'élaboration d'une macro... car je l'avoue, je débute.
Voici les données: (Pour simplifier, j'ai mis toutes mes feuilles dans le même classeur... bien que ça ne m'arrange pas forcément)
Sur la feuille 1 ("saisie") je souhaite entrer les données (Dans la ligne 16) puis en cliquant sur mon bouton "Enregistrer", la macro intervient pour:
a) selon le nom du cheval entré en A16, elle copie la ligne de donnée et la colle dans la feuille du cheval correspondant ("détails" xx), bien sûr dans les même colonnes (les feuilles détails sont faîtes sur le même modèle que la feuille "saisie" sauf qu'il n'y a pas la colonne NOM), à la suite des autres lignes déjà enregistrées
b) enregistrer
c) vider les données de la feuille "saisie" afin d'en entrer des nouvelles.

Donc j'ai mis mon fichier en pièce jointe avec ma macro qui ne fonctionne pas.
Quelqu'un peut-il me donner un coup de pouce? MERCI d'avance!

Ma macro:

Sub ENREGISTREMENT_QuandClic()


If A16 = "BLUE DAMASK" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(4).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "AILTON" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(2).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "FIGHTING" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(8).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "MAJOR" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(18).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "GABALDEN" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(10).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "GANIMETTE" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(12).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "DEBBY" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(6).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "LUMISSON" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(14).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "SAHARA" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(22).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "MOPSOS" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(20).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "MAINTOP" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(16).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If


If A16 = "ZAFEERELI" Then
ActiveSheet.Range("B16:L16").Copy_
destination: Worksheets(24).Range ("A4:K4")
expression.Save
ActiveSheet.Empty (A16 - L16)
End If

End Sub

 

[penelope]

Re : Macro pour copier/coller selon critère

Bonjour Gorfael, Si... et le forum,
J'ai analysé (et compris) vos deux méthodes. J'ai finalement poursuivi ce que j'avais commencé avec Gorfael et CA FONCTIONNE!!!!! 😀
Je n'ai pas opté pour la méthode de Si... pour la raison suivante, bien que son code était beaucoup plus "simple" et court:
Son code dépendait un peu du 1er qui détermine les onglets. Et celui-ci m'emb^était quelque peu car la mise en forme ne correspondait pas à ce que je voulais (il n'y a que les lignes collées qui s'affichent, sans les en-têtes et couleurs etc que j'avais prévue.)
Et comme j'avais déjà préparé tous mes onglets il y a quelque temps, le "travail" était déjà fait, bien qu'il emplifie la possibilité d'erreur. Mais je garde précieusement cette méthode car c'est vrai qu'elle peut être très utile.
Je n'ai pas changé mon "expression.save" dans un premier temps et il semble le comprendre car il ne m'a fait aucune remarque d'erreur... Bon, pour l'instant, je vais poursuivre mes travaux et me permettrai de vous solliciter si j'ai des difficultés😎
Merci
A+