XL 2019 Macro VBA pour copie contenu d'une cellule dans une autre

GDINFO

XLDnaute Junior
Supporter XLD
Bonjour

je galère toujours mais j'avance

le but est que je fasse une macro qui lors de son activation me copie le contenu de la cellule sélectionnée dans une autre cellule de sauvegarde et reste bien sur sur ma cellule de depart

Exemple : je sélectionne la cellule de A3 jusqu'à K3 et lors de la sélection le contenu se recopie dans A1 mais reste sur la cellule sélectionnée départ

Merci de votre aide

Pièces jointes​

 

Pièces jointes

  • Select.Copy.xlsm
    13.8 KB · Affichages: 5

GDINFO

XLDnaute Junior
Supporter XLD
Bonjour Gdinfo,

A3:K3 est une plage, comment recopie t-on une plage dans une cellule ?
Dans votre fichier A1= H3. Pourquoi H3 ?
je me suis mal expliqué

Quand je sélectionne une cellule A3 ou B3 ou jusqu'a K3 , (une seule cellule a la fois bien sur, pas une selection de cellule)

Pour dire plus simple

Si je suis sur la cellule A3 et je lance la macro le contenu se copie dans A1 et je peux modifié la cellule A3 , mais je garde en visuel l'ancien contenu de A3 , jusqu'a une nouvelle selection de cellule
 

GDINFO

XLDnaute Junior
Supporter XLD
je me suis mal expliqué

Quand je sélectionne une cellule A3 ou B3 ou jusqu'a K3 , (une seule cellule a la fois bien sur, pas une selection de cellule)

Pour dire plus simple

Si je suis sur la cellule A3 et je lance la macro le contenu se copie dans A1 et je peux modifié la cellule A3 , mais je garde en visuel l'ancien contenu de A3 , jusqu'a une nouvelle selection de cellule
Et dans cette macro , je voudrais rajouter + 1 a la valeur qu'il y avait.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Et dans cette macro , je voudrais rajouter + 1 a la valeur qu'il y avait.
En PJ deux exemples possibles.
Feuil1, c'est automatique il suffit de cliquer sur une cellule dans A3:K3 pour recopier la valeur+1 en A1, avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
         [A1] = Target + 1
    End If
Fin:
End Sub
En Feuil2 avec un bouton et la macro:
Code:
Sub Copie()
    If ActiveCell.Count > 1 Then Exit Sub
    If ActiveCell.Row = 3 And ActiveCell.Column >= 3 And ActiveCell.Column <= 11 Then [A1] = ActiveCell.Value + 1
End Sub

Par contre la phrase "rajouter + 1 a la valeur qu'il y avait." est ambiguë, on ne sait pas si on rajoute +1 à la cellule ou à A1.
En PJ2, c'est pareil, mais on ajoute +1 à la cellule et non à A1. Avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
        Application.EnableEvents = False
        [A1] = Target
        Target = Target + 1
        Application.EnableEvents = True
    End If
Fin:
End Sub

et

Sub Copie()
    If ActiveCell.Count > 1 Then Exit Sub
    If ActiveCell.Row = 3 And ActiveCell.Column >= 3 And ActiveCell.Column <= 11 Then
        [A1] = ActiveCell.Value
        ActiveCell.Value = ActiveCell.Value + 1
    End If
End Sub
 

Pièces jointes

  • Select.Copy (2).xlsm
    16.6 KB · Affichages: 2
  • Select.Copy (3).xlsm
    16.1 KB · Affichages: 1
Dernière édition:

GDINFO

XLDnaute Junior
Supporter XLD
Re,

En PJ deux exemples possibles.
Feuil1, c'est automatique il suffit de cliquer sur une cellule dans A3:K3 pour recopier la valeur+1 en A1, avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
         [A1] = Target + 1
    End If
Fin:
End Sub
En Feuil2 avec un bouton et la macro:
Code:
Sub Copie()
    If ActiveCell.Count > 1 Then Exit Sub
    If ActiveCell.Row = 3 And ActiveCell.Column >= 3 And ActiveCell.Column <= 11 Then [A1] = ActiveCell.Value + 1
End Sub

Par contre la phrase "rajouter + 1 a la valeur qu'il y avait."
Re,

En PJ deux exemples possibles.
Feuil1, c'est automatique il suffit de cliquer sur une cellule dans A3:K3 pour recopier la valeur+1 en A1, avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
         [A1] = Target + 1
    End If
Fin:
End Sub
En Feuil2 avec un bouton et la macro:
Code:
Sub Copie()
    If ActiveCell.Count > 1 Then Exit Sub
    If ActiveCell.Row = 3 And ActiveCell.Column >= 3 And ActiveCell.Column <= 11 Then [A1] = ActiveCell.Value + 1
End Sub

Par contre la phrase "rajouter + 1 a la valeur qu'il y avait." est ambiguë, on ne sait pas si on rajoute +1 à la cellule ou à A1.
En PJ2, c'est pareil, mais on ajoute +1 à la cellule et non à A1. Avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
        Application.EnableEvents = False
        [A1] = Target
        Target = Target + 1
        Application.EnableEvents = True
    End If
Fin:
End Sub

et

Sub Copie()
    If ActiveCell.Count > 1 Then Exit Sub
    If ActiveCell.Row = 3 And ActiveCell.Column >= 3 And ActiveCell.Column <= 11 Then
        [A1] = ActiveCell.Value
        ActiveCell.Value = ActiveCell.Value + 1
    End If
End Sub
Oui demande ambigue
ou à A1.
En PJ2, c'est pareil, mais on ajoute +1 à la cellule et non à A1. Avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
        Application.EnableEvents = False
        [A1] = Target
        Target = Target + 1
        Application.EnableEvents = True
    End If
Fin:
End Sub

et

Sub Copie()
    If ActiveCell.Count > 1 Then Exit Sub
    If ActiveCell.Row = 3 And ActiveCell.Column >= 3 And ActiveCell.Column <= 11 Then
        [A1] = ActiveCell.Value
        ActiveCell.Value = ActiveCell.Value + 1
    End If
End Sub
 

GDINFO

XLDnaute Junior
Supporter XLD
PJ2 parfait , je n'ai plus qu' adapté a mon fichier PROD , mais au lieu de faire +1 je vais devoir ajouter du texte ,mais je devrais y arriver

C'est pas la première fois que vous m'aider et je vous en remercie beaucoup, j'ai beaucoup appris avec votre aide
et si dans la cellule select il y a du texte et non du numérique , comment copier réellement le contenu, même si le +1 se fait pas c'est pas grave
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Il suffit de supprimer le +1, ça copiera la valeur quelle qu'elle soit numérique ou alpha :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
         [A1] = Target
    End If
Fin:
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
ou mieux, copie la cellule et si celle ci est numérique on fait +1 sinon on ne fait rien. Avec :
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A3:K3")) Is Nothing Then
        [A1] = Target
        If IsNumeric(Target) Then
            Application.EnableEvents = False
            Target = Target + 1
            Application.EnableEvents = True
        End If
    End If
Fin:
End Sub
 

Pièces jointes

  • Select.Copy (4).xlsm
    15.1 KB · Affichages: 5

GDINFO

XLDnaute Junior
Supporter XLD
Derniere demande adaptative

j'ai cette macro

Sub SetValue_RJEcoD()
Const RJEd = "RJEd "
Call GetColors(ActiveCell)
ActiveCell.Value = ActiveCell.Value + RJEd
Call SetColors(ActiveCell)
ActiveCell.Characters(Start:=Len(ActiveCell.Value) - Len(RJEd) + 1, Length:=Len(RJEd)).Font.ColorIndex = 5
End Sub

et avant quelle s'execute je voudrais integre la votre qui me copie le contenu dans la cellue A1
 

GDINFO

XLDnaute Junior
Supporter XLD
Derniere demande adaptative

j'ai cette macro

Sub SetValue_RJEcoD()
Const RJEd = "RJEd "
Call GetColors(ActiveCell)
ActiveCell.Value = ActiveCell.Value + RJEd
Call SetColors(ActiveCell)
ActiveCell.Characters(Start:=Len(ActiveCell.Value) - Len(RJEd) + 1, Length:=Len(RJEd)).Font.ColorIndex = 5
End Sub

et avant quelle s'execute je voudrais integre la votre qui me copie le contenu dans la cellue A1
en gros c'est enchainer la copie du contenu dans A1 puis le rajout de +RJED
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG