Dupliquer une plage de cellule via un bouton macro

Bonjour,

je souhaiterais via un bouton macro copier les 3 cellules situées sur la gauche du bouton pour les dupliquer à partir de la deuxième cellule située vers la droite du bouton.

J'ai utilisé l'enregistrement de macro qui m'a donné ceci :

Sub dupliquer()

'

' dupliquer Macro

'

'

Range("C1:F1").Select

selection.Copy

Range("G1").Select

ActiveSheet.Paste

End Sub

Ca fonctionne bien quand j'ai qu'un seul bouton, mais j'aimerais avoir un bouton par ligne et du coup je n'arrive pas a coder de manière à ce que les range ne soit pas fixe mais variable selon la position de la cellule bouton.

J'ai essayé avec un code du style :

A = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row

B = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column

afin de remplacer les adresses de cellules par A ou B

mais il me manque un peu de technique.

Je joint mon fichier.

Auriez vous une idée ?

Merci d'avance

Bonjour Fabrice, bonjour le forum,

Plutôt que de multiplier les boutons pourquoi ne pas agir au double-clic (pour +) / Clic-droit (pour -) avec (à placer dans le composant Feuil1(test)) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Target.Value = Target.Value + Target.Offset(0, -1).Value: Target.Offset(1, 0).Select
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Value = Target.Value - Target.Offset(0, -1).Value: Target.Offset(1, 0).Select
End Sub

Il te suffit de garder un bouton de chaque pour expliqer : + = Double-Clic / - = Clic-droit...

Bonjour ThauThème,

merci de la réponse.

en ce qui concerne le double clic, je vais proposer et essayer (c'est pour faciliter le boulot de collègue).

Mais j'ai aussi une histoire de pas (quand c'est à la pièce de 1 en 1, quand c'est au kilo de 0.5 en 0.5 etc).

Donc j'aimerais aussi essayer de dupliquer les colonnes pour essayer, d’où mon post pour dupliquer sur la droite du bouton "dupliquer " à l'infini peut importe ou est le bouton.

Et je ne maitrise pas la modification de l'adresse de la cellule pour la rendre relative au bouton.

Merci

Bonjour Fabrice0501, ThauThème ( ), le forum,

copier les 3 cellules situées sur la gauche du bouton pour les dupliquer vers la droite du bouton

J'ai essayé avec un code du style :

A = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row

B = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column

afin de remplacer les adresses de cellules par A ou B

Peut-être ainsi alors...

Sub dupliquer()

Dim A As Integer, B As Integer

    A = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    B = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column

    Range(Cells(A, B - 3), Cells(A, B)).Copy Cells(A, B + 1)

End Sub

Cordialement,

Bonjour xorsankukai ,

effectivement c'est ce que je recherche

je n'arrivais pas a formuler ce code basique lol

merci beaucoup de votre aide

Rebonjour,

quel serait la modification a apporter pour coller également la largeur de colonne en même temps.

Sub dupliquer()

Dim A As Integer, B As Integer

A = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row

B = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column

Range(Cells(A, B - 3), Cells(A, B)).Copy Cells(A, B + 1)

End Sub

Merci

Re,

[u]

A tester:[/u]

Sub dupliquer()

Dim A As Integer, B As Integer

    A = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    B = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column

    Range(Cells(A, B - 3), Cells(A, B)).Copy Cells(A, B + 1)   'copie/colle le contenu
     Range(Cells(A, B - 3), Cells(A, B)).Copy
     Cells(A, B + 1).PasteSpecial 8     'colle le format

     Application.CutCopyMode = False     'désélectionne les cellules copiées
End Sub

Bonne soirée,

xorsankukai a écrit :

Re,

[u]

A tester:[/u]

Sub dupliquer()

Dim A As Integer, B As Integer

    A = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    B = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column

    Range(Cells(A, B - 3), Cells(A, B)).Copy Cells(A, B + 1)   'copie/colle le contenu
     Range(Cells(A, B - 3), Cells(A, B)).Copy
     Cells(A, B + 1).PasteSpecial 8     'colle le format

     Application.CutCopyMode = False     'désélectionne les cellules copiées
End Sub

Prise de commande 1.0-1.xlsm

Bonne soirée,

Fonctionne parfaitement

Merci beaucoup pour l'aide