Macro copier-coller spécial

[Rosco]

Hello tout le monde,

Je suis en train de créer un tableau pour planifier des séances d'entraînement.
Certaine donnée sont transférer avec la macro ci-dessous.
Mais elle ne transfère pas toute les différentes couleurs de remplissage des cellules.😕


Sub Copiercoller()
'
' Copiercoller Macro
' Macro enregistrée le 13.09.2010 par Arn M.
'

'
Sheets("Annuel").Select
Range("F18:AJ21").Select
Selection.Copy
Sheets("1").Select
Range("H9:K39").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

Un grand merci pour aide très précieuse.
🙂

 

[Efgé]

Re : Macro copier-coller spécial

Bonjour Rosco,
peut être

[COLOR=blue]Sub[/COLOR] Copiercoller()
Sheets("Annuel").Range("F18:AJ21").Copy
[COLOR=blue]With[/COLOR] Sheets("1").Range("H9")
    .PasteSpecial Paste:=xlPasteValues, Transpose:=True
    .PasteSpecial Paste:=xlPasteFormats, Transpose:=True
[COLOR=blue]End With[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Cordialement
EDIT: Bonsoir robert

 

[Robert]

Re : Macro copier-coller spécial

Bonsoir Rosco, bonsoir le forum,

Il est préférable éviter autant que l'on peut le faire les Select qui ralentissent considérablement l'exécution du code. Je te propose le code suivant :

Sub Copiercoller()
Dim dest As Range 'déclare la variable dest (DESTination)
Sheets("Annuel").Range("F18:AJ21").Copy 'copie la plage F18:AJ21
Set dest = Sheets("1").Range("H9") 'définit la cellule de destination
'colage special
dest.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

Éditon :

Bonsoir Efgé on s'est croisé