Copier des données d'une feuille à l'autre via bouton de commande

Question

Je souhaite copier des données de multiples feuilles (27 feuilles), vers une unique feuille (appelée "STATS") à l'aide d'un bouton de commande sur chaque feuille. les emplacements de données sont toujours les mêmes. j'aimerais bien que ce qui a été copié se colle dans la dernier ligne non vide de ma feuille. Mon tableau commence en ligne 3. un petit tableau récap = A1 à copier =&gt; coller en colonne C dans la feuille "STATS" B19 à copier =&gt; coller en colonne D ... E19 à copier =&gt; coller en colonne E ... H19 à copier =&gt; coller en colonne F ... K19 à copier =&gt; coller en colonne G ... M1 à copier =&gt; coller en colonne H ... L1 à copier =&gt; coller en colonne I ... Quelques précisions: Hormis tout ce qui est en A, le reste sont des résultats de formules. A n'est que du texte. J'ai mis qu'un seul bouton de commande en feuille "A - 1135", c'est le module 1. Le bouton est "Copier et Sauver". Pas de données confidentielles dans mon document, qui est en zip (car trop lourd). Je vous laisse coder pour la lettre A... J'adapterai pour la suite de mon fichier. Pas d'urgence, c'est à but récréatif. Un grand merci à vous pour votre aide les vba-teurs ...

Arturo83 · Accepted Answer

J'ai remplacé votre bouton "ActiveX" par un objet dessiné ayant la même apparence mais avec un code unique pour toutes les feuilles. Il vous suffira simplement de recopier ce bouton. Le code est dans le module standard "Module28". Le code: Sub Sauvegarder_dans_Stats() Dim f1 As Worksheet, f2 As Worksheet Dim DerLig_f1 As Long Application.ScreenUpdating = False Set f1 = Sheets("STATS") Set f2 = Sheets(ActiveSheet.Name) DerLig_f1 = f1.Range("C" & Rows.Count).End(xlUp).Row + 1 f1.Range("C" & DerLig_f1) = f2.Range("A1") f1.Range("D" & DerLig_f1) = f2.Range("B19") f1.Range("E" & DerLig_f1) = f2.Range("E19") f1.Range("F" & DerLig_f1) = f2.Range("H19") f1.Range("G" & DerLig_f1) = f2.Range("K19") f1.Range("H" & DerLig_f1) = f2.Range("M19") f1.Range("I" & DerLig_f1) = f2.Range("L1") Set f1 = Nothing Set f2 = Nothing End Sub Votre fichier: Cdlt...