Comment adapter une macro à plusieurs boutons

Jossyl -  
 Jossyl -
Bonjour,

Je cherche une personne qui pourrait m'aider à démêler ce problème :

Ma macro de référence est celle-ci :

Sub Ajout()
Range("F5:I5").Select
Selection.Copy
Sheets("Devis de référence").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

Ce que je veux c'est que cette macro soit automatiquement adaptée pour "F6:I6", "F7:I7" et ainsi de suite à l'infini sans avoir à modifier moi-même la macro pour chaque ligne.

Merci beaucoup pour vos conseils

1 réponse

  1. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Plutôt que de mettre des dizaines de boutons, le plus simple serait d'utiliser une macro événementielle (par exemple sur clic droit) pour copier les cellules désirées.

    Il faudrait que tu nous dises à quel endroit de la feuille « Devis de référence » il faut copier ces informations.

    Voici un exemple qui copie les 4 formules (ne serait-ce pas plutôt les valeurs qu'il faut copier ?) en A1 de « Devis de référence »

    Fais un clic droit sur l'onglet de la feuille ou se trouvent les valeurs à copier / visualiser le code / et copie y le code ci-dessous.

    Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
      If Intersect(Target, Columns("F")) Is Nothing Then Exit Sub
      If Target.Row < 5 Then Exit Sub
      Target.Resize(1, 4).Copy
      Sheets("Devis de référence").Cells(1, 1).PasteSpecial Paste:=xlPasteFormulas
      Application.CutCopyMode = False
      Cancel = True
    End Sub


    Un clic droit dans la cellule F5 (ou F6, ou ...) copie les valeurs
    0
    1. Jossyl
       
      Merci beaucoup Patrice33740, ta formule a ENFIN résolu mon problème de façon beaucoup plus simple que je ne l'avait pensé !!! Je l'ai adapter à ce que je voulais faire exactement car oui, je voulai copier les valeurs mais pas la mise en forme dans les cellules déjà sélectionnées dans l'autre feuille, à la fin ça donne ça et ça marche très bien.

      Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
      If Intersect(Target, Columns("F")) Is Nothing Then Exit Sub
      If Target.Row < 5 Then Exit Sub
      Target.Resize(1, 4).Copy
      Sheets("Devis de référence").Select
      Selection.
      PasteSpecial Paste:=xlPasteFormulas
      Application.CutCopyMode = False
      Cancel = True
      End Sub

      En tout cas merci encore, tu m'as réconcilié avec mon ordi et les forums sur internet par la même occasion ;-) Bonne journée à toi.
      0