Microsoft 365 Copier coller les mêmes valeurs dans la même cellule

[pat66]

Bonsoir le forum,

J'ai des valeurs dans I21,I23,I25,I27 et je souhaite à l'aide d'une macro qu'au :
1er clic ces cellules se vident mais mémorise les valeurs présentes (copier) et si je reclique ces cellules se remplissent des mêmes valeurs (coller)

j'espère être clair en espérant que cela soit possible

un grand merci pour votre aide

 

[sylvanu]

Bonjour Pat,

1er clic si je reclique

Vous cliquez sur quelle cellule dans les 2 cas ?
Sur une de ces cellules I21,I23,I25,I27 ou autre part ?

 

[pat66]

autre part avec une forme à qui j'affecterai cette macro

 

[sylvanu]

Re,
Si on clic sur I21,I23,I25,I27 que ça mémorise les valeurs et vide leur contenu, vous ne pourrez jamais remplir ces cellules car au premier clic ce sera vidé.
Une idée en PJ :
On remplit les cellules, une clique sur une cellule quelconque et en appuyant sur le bouton on transfert les valeurs à l'endroit indiqué. Avec :

Sub CopierColler()
    T = [I21:I27]
    Range(ActiveCell.Address).Resize(7, 1).Value = T
    [I21:I27].ClearContents
End Sub

 

[pat66]

re,

oui bien sur c'est une bonne idée, mais malheureusement , au second clic les valeurs de T ne reviennent pas dans [I21:I27]

 

[sylvanu]

Un nouvel essai.
Par contre au second clic doit on effacer ce qui avait été préalablement collé ?
En Pj on efface pas ce qui avait été collé.

 

[pat66]

re,

oui cela fonctionne, mais peux t'on alors coller ses valeurs toujours dans les mêmes cellules cela nous permettrai de les effacer, exemple : [L21:L27] = [I21:I27] et sans avoir à cliquer sur des cellules de [I21:I27] en sachant que le contenu de [I21:I27] est affiché ou se vide simultanément

merci

 

[job75]

Bonsoir pat66, sylvanu,

1) Placez cette macro dans le code de la feuille de calcul :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim a, i&
a = [memo]
If IsArray(a) Then
    For i = 1 To UBound(a)
        Range(a(i, 1)) = a(i, 2)
    Next i
    ThisWorkbook.Names("memo").Delete
Else
    Set Target = Intersect(Target, UsedRange)
    If Target Is Nothing Then Exit Sub
    ReDim a(1 To Target.Count, 1 To 2)
    For Each Target In Target
        i = i + 1
        a(i, 1) = Target.Address
        a(i, 2) = Target
        Target = ""
    Next Target
    ThisWorkbook.Names.Add "memo", a
End If
End Sub

2) Touche Ctrl enfoncée sélectionnez les cellules que vous voulez traiter puis clic droit => les valeurs sont effacées.

3) Clic droit sur une cellule quelconque pour restituer les valeurs.

A+

 

[job75]

Maintenant on peut fixer dès le départ la plage à étudier, plus besoin de sélection multiple :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Set Target = [I21,I23,I25,I27] 'plage à étudier, modifiable
Dim a, i&
a = [memo]
If IsArray(a) Then
    For i = 1 To UBound(a)
        Range(a(i, 1)) = a(i, 2)
    Next i
    ThisWorkbook.Names("memo").Delete
Else
    ReDim a(1 To Target.Count, 1 To 2)
    For Each Target In Target
        i = i + 1
        a(i, 1) = Target.Address
        a(i, 2) = Target
        Target = ""
    Next Target
    ThisWorkbook.Names.Add "memo", a
End If
End Sub

Le clic droit est à faire 2 fois, sur n'importe quelle cellule.

 

[pat66]

re,
bonsoir job75

et merci pour votre aide, mais le bouton macro qui copie, mémorise et réécrit ces valeurs est situé sur une autre feuille, je ne peux donc pas les sélectionner ni faire un clic droit

Pardonnez moi, j'ai du mal m'exprimé :

je souhaite que ce bouton macro situé sur la feuille 1 copie les valeurs de la feuille 2 [I21,I23,I25,I27], les colle par exemple dans [L21,L23,L25,L27] de la feuille 2 pour mémoire et vide les cellules feuille 2 [I21,I23,I25,I27], , et que si je reclique sur ce bouton macro de la feuille 1, la macro va chercher ces valeurs et les recolle dans [I21,I23,I25,I27] de la feuille 2

merci beaucoup pour votre patience

 

[sylvanu]

Plus grand chose à voir avec la demande initiale.
Une PJ pour voir.

 

[pat66]

re,

yes !!! Merci sylvanu,

c'est exactement ce dont j'avais besoin, et encore merci pour votre compréhension et votre patience

bonne soirée à tous

 

[job75]

Oui ou aussi :

Sub Couper_Ccller()
Dim c As Range
With Sheets("Feuil2").[I21,I23,I25,I27]
    If Application.CountA(.Cells) Then
        For Each c In .Cells
            c.Copy c(1, 4): c.Clear
        Next c
    Else
        For Each c In .Cells
            c(1, 4).Copy c: c(1, 4).Clear
        Next c
    End If
End With
End Sub