Macro interactive pour Copie de cellule

Chri8Ed

XLDnaute Occasionnel
Bonjour


Je copie souvent des cellules de mon grand tableau.
Pour me faciliter la tâche j’aimerais avoir 2 macros interactives.

Faire une macro qui copie une cellule précise vers une autre cellule précise n’est pas bien compliqué.
Mais la rendre doublement interactive !
Mais connaissances en macro sont encore justes.



Pour la macro 1, voilà ce que je souhaiterais pouvoir faire :
Je lance ma macro (par exemple « Ctrl Alt C »)
Je pointe une cellule quelconque (par exemple A1)
Je pointe une autre cellule (par exemple A2)
Et la cellule A1 se copie sur la cellule A2
En copiant son format (Couleur, Bordure et son étiquette commentaire)
Cette cellule qui contient une date au format jj/mm doit également ce mettre à la date du jour

Ex : A1 = 10/01 => A2 = 18/08



Pour la macro 2, voilà ce que je souhaiterais pouvoir faire :
Je lance ma macro (par exemple « Ctrl Alt R »)
Je pointe une cellule quelconque (par exemple B1)
Je pointe une autre cellule (par exemple B2)
Et la cellule B1 se copie sur la cellule B2
En copiant son format (Couleur, Bordure et son étiquette commentaire)
Mais Sans mise à jour de la date
Puis la cellule B1 s’efface et reprend une couleur neutre (Violet dans mon tableau)

Je ne peux pas utiliser la fonction « couper/Coller »
Car cela provoque dans mon tableau des problèmes importants à cause de l’utilisation de mise en forme conditionnelle
 

Chri8Ed

XLDnaute Occasionnel
Re : Macro interactive pour Copie de cellule

Bonjour

Je me suis bien bien sûr déjà essayé avant de poster ma demande

C'est un minimum

Comme je l'ai dit, c'est la double interactivité de cette macro qui me pose problème

Et çà, l'enregistreur de macro ne peut me le donner
 
G

Guest

Guest
Re : Macro interactive pour Copie de cellule

Bonsoir,

Hello Pierrot:)

La macro1 pourrait ressembler à ça

Avant de la lancer:
Sélectionner 1 cellule puis avec la touche CTRL enfoncée sélectionner la cellule de destination.

VB:
Sub Macro1()
    With Selection
        If .Cells.Count <> 2 Or .Areas.Count <> 2 Then Exit Sub
        .Item(1).Copy
        With .Areas(2)(1)
            .PasteSpecial xlPasteFormats
            .PasteSpecial xlPasteComments
            .Value = Date
        End With
    End With
    Application.CutCopyMode = False
End Sub

Pour la deuxième je te laisse imaginer.

A+
 
G

Guest

Guest
Re : Macro interactive pour Copie de cellule

Re,

Ou plus simple:

copier la cellule source (ctrl+C), sélectionner la cellule destiantion et lancer la macro qui collera dans la cellule active

VB:
Sub Macro1()
    With ActiveCell
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteComments
        .Value = Date
    End With
End Sub

A+
 

Chri8Ed

XLDnaute Occasionnel
Re : Macro interactive pour Copie de cellule

Bonjour Hasco

D’abord merci beaucoup pour ton aide

J’ai choisi la 1ère solution
Elle est parfaite et me convient très bien

Pour la 2ème macro, je butte
En fait avec la macro suivante
J’efface bien une cellule, mais pas la bonne
J’efface en faut la cellule que je viens de copier et non la cellule d’originale.:mad:

Sub DéplaceCellule_D()
'
' DéplaceCellule_D Macro
'
' Touche de raccourci du clavier: Ctrl+d
'
With Selection
If .Cells.Count <> 2 Or .Areas.Count <> 2 Then Exit Sub
.Item(1).Copy
With .Areas(2)(1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteComments
.Value = Date
End With
End With
Application.CutCopyMode = False

Ligne = ActiveCell.Row
Colonne = ActiveCell.Column

[A4].Copy
Cells(Ligne, Colonne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ActiveCell.Offset(1, 0).Range("A1").Select

End Sub
 
G

Guest

Guest
Re : Macro interactive pour Copie de cellule

Re,

Ce pourrait-être:
VB:
Sub Macro2()
     With Selection
         If .Cells.Count <> 2 Or .Areas.Count <> 2 Then Exit Sub
         .Item(1).Copy
         With .Areas(2)(1)
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteFormats
             .PasteSpecial xlPasteComments
         End With
         .Item(1).Clear
     End With
     Application.CutCopyMode = False
 End Sub

Mais cela aussi, plus simple copie tout d'un coup,

VB:
Sub Macro2bis()
     With Selection
         If .Cells.Count <> 2 Or .Areas.Count <> 2 Then Exit Sub
         With .Item(1)
            .Copy Destination:=Selection.Areas(2)(1)
            .Clear
         End With
     End With
     Application.CutCopyMode = False
 End Sub

A+
 

Chri8Ed

XLDnaute Occasionnel
Re : Macro interactive pour Copie de cellule

Merci mais ce n’est pas cela

La cellule est bien effacée
Mais du coup elle perd son format

C’est pour cela que je tentais de recopier la « cellule X4 » (Cellule qui reste toujours vide et qui possède le bon format) plutôt que d’effacer la cellule d’origine.

Comme cela je me retrouverais avec une cellule Violette avec des Bordures et son Format horaire jj/mm
 

Chri8Ed

XLDnaute Occasionnel
Re : Macro interactive pour Copie de cellule

Re Merci

C’est presque cela

Le format horaire est bien conservé
Les bordures aussi

Mais la couleur reste la couleur de l’ancienne cellule déplacée
Elle ne prend pas la couleur violette

Et le commentaire n’est pas effacé
 

Chri8Ed

XLDnaute Occasionnel
Re : Macro interactive pour Copie de cellule

Bonjour

On touche presque au but

J’ai rajouté « .Interior.Color = 16751052 »
Et la couleur violette revient comme à l’origine

Seul problème, qui est aléatoire :

Je perds parfois ma bordure gauche ???
La bordure droite reste elle toujours présente
(Il n’y a pas de bordures horizontales)

J’ai essayé de comprendre, mais sans succès :confused:
 

Chri8Ed

XLDnaute Occasionnel
Re : Macro interactive pour Copie de cellule

Bonsoir

J’ai un gros problème avec la fonction :
« .Interior.Color = 16751052 »

Elle agit aussi bien sur la macro qui vient d’être supprimée
C’est ce que je souhaite

Mais elle agit aussi sur la macro qui vient d’être copier :mad:
 

Discussions similaires

Réponses
2
Affichages
143

Statistiques des forums

Discussions
312 243
Messages
2 086 541
Membres
103 244
dernier inscrit
lavitzdecreu