Macro copier/coller format

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion skun
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

skun

XLDnaute Occasionnel
Bonjour le forum,

J'aimerai copier/coller le format (couleur/cadrage) d'un tableau.
C'est difficile à expliquer mais très facile à comprendre 😀

La macro copie/colle des lignes en bas du tableau en fonction des dates de la colonne A (avec un espace de 2 lignes entre chaque date) , mais je n'arrive pas à déterminer sur quelle plage doit être pris en compte le copier/coller format de la macro. Actuellement elle ne copie/colle que la ligne de la date.. or il manque 2 lignes.

Désolés si je n'est pas était clair, mais le fichier joint sera beaucoup plus explicite que moi (l'erreur à partir de A191, là où est effectué le collage)

Note: la macro s'exécute à l'ouverture du fichier.


le CODE (merci pierrejean): j'ai coloré la partie que je pense qui est concernée
Code: 
Sub test()
Application.ScreenUpdating = False
While Range("A4") < Date - (2 * 365)
  Rows(3).Delete
 
Wend
derdate = Range("A65536").End(xlUp)
MsgBox (derdate)
Select Case derdate > Date + 31
Case True
  While Range("A65536").End(xlUp) > Date + 31
    Rows(Range("A65536").End(xlUp).Row).Delete
  Wend
Case False
  While Range("A65536").End(xlUp) < Date + 30
     [COLOR="Blue"]Rows(Range("A5:A7").End(xlUp).Row).Copy
   Rows(Range("A65536").End(xlUp).Row + 3).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _[/COLOR]
        False, Transpose:=False
    Range("A65536").End(xlUp).Offset(3, 0) = Range("A65536").End(xlUp) + 1
  Wend
  Application.CutCopyMode = False
End Select
Application.ScreenUpdating = True
End Sub

Quelqu'un aurait il une piste à me donner svp?

salutations


skun
 

Pièces jointes

Trier par date Trier par votes
Re : Macro copier/coller format

Salut Hasco,

dsl je n'ai pas pu répondre plus tôt,
ca marche super mise à part les bordures qui ne sont pas exactement recopier à l'intérieur de la colonne A.(un trait plus épais devrait apparaître dans le sens horizontal, 1 ligne après la date)

(voir fichier joint)

sais tu comment je peux régler ca?

je te remercie

salutations

skun
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Macro copier/coller format

Bonjour Skun,

Les copies de format posent souvent ce genre de problème.
Fait une macro avec l'enregistreur de macro pour la mise en forme des cellules que tu appelleras en fin de première macro.

A+
 
Vote positif 0 Vote négatif
Re : Macro copier/coller format

bonjour le forum, bonjour hasco,

j'ai donc suivi ton conseil , j'ai fait cette première macro.
Code: 
Sub findepremièremacro()

    Rows("4:6").Select
    Selection.Copy

    Range("A186").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A189").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
   
    Range("A192").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

le problème, c'est que dans la macro initiale, il y a une vrai "intelligence" de la macro, elle calcule le nombre de ligne(date) à créer par rapport à la date d'aujourd'hui. La création de ligne(date) est donc variable, or avec la macro enregistré, c'est du prédéfini 🙁 donc la plage de la copy est variable

Mais peut-être as tu une idée pour celà?

Moi j'ai essayé: de modifier la macro initiale.. mais ca marche pas.

Code: 
Sub test()
    Application.ScreenUpdating = False
    While Range("A4") < Date - (2 * 365)
        Rows(3).Delete

    Wend
    derdate = Range("A65536").End(xlUp)
    MsgBox (derdate)
    Select Case derdate > Date + 31
    Case True
        While Range("A65536").End(xlUp) > Date + 31
            Rows(Range("A65536").End(xlUp).Row).Delete
        Wend
    Case False
        While Range("A65536").End(xlUp) < Date + 30
            Rows(Range("A65536").End(xlUp).Row).Copy
            Rows(Range("A65536").End(xlUp).Row + 3).Resize(3).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                                                                           False, Transpose:=False
            Range("A65536").End(xlUp).Offset(3, 0) = Range("A65536").End(xlUp) + 1
        Wend
        
          [COLOR="RoyalBlue"]  While Rows("4:6").Select
    Selection.Copy

    Range("A65536").End (xlUp) < Date + 30
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Wend[/COLOR]
        
        Application.CutCopyMode = False
    End Select
    Application.ScreenUpdating = True
End Sub

voilou

je te remercie

salutations

skun



PS: j'avais pensé sinon à une mise en forme conditionnelle, mais je n'ai pas réussie(sans vba) à parramettrer pour faire des lignes épaisse.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro copier/coller format

Re skun,

Ce que je te suggérais étais de créer une macro de mise en forme et non de collage de format.

Une macro du style:

Code: 
Sub MiseEnForme()
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
End Sub

Où tu remplacera Selection par la plage de cellule calculée dans la macro précédente.

Code: 
Sub MiseEnForme(LaPlage As Range)
    LaPlage.Borders(xlDiagonalDown).LineStyle = xlNone
    LaPlage.Borders(xlDiagonalUp).LineStyle = xlNone
    LaPlage.Borders(xlEdgeLeft).LineStyle = xlNone
'.......
End Sub

A+
 
Vote positif 0 Vote négatif
Re : Macro copier/coller format

Re,

Ok je vois ce que tu veux dire,
j'ai donc crée la macro c'est ok, et je galère un peu pour la sélection.
Car si j'utilise la selection (chose que je n'arrive tout de facon pas à faire :x) de l'ancienne macro, ca ne tombera pas pile au niveau des bordures, et ca ne fera pas ce que je souhaite.

Code: 
    Range("[COLOR="RoyalBlue"]XXXXXXXX[/COLOR]").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone


Cependant j'ai une sélection qui pourrait etre plus appropriée,

mais je n'arrive pas à la faire.

il faudrait que pour toute les dates > aujourdhui()
ca selectionne 3 lignes:
-une ligne avant la date
-la ligne de la date
-et la ligne aprés la date

(si possible pouvoir délimité jusqu'à une colonne AT)


Je te remercie


salutations



skun
 
Vote positif 0 Vote négatif
Re : Macro copier/coller format

Re Skun,

Voici ta macro Test modifiée:

Code: 
Sub test()
    Application.ScreenUpdating = False
    While Range("A4") < Date - (2 * 365)
        Rows(3).Delete
    Wend
    derdate = Range("A65536").End(xlUp)
    MsgBox (derdate)
    Select Case derdate > Date + 31
    Case True
        While Range("A65536").End(xlUp) > Date + 31
            Rows(Range("A65536").End(xlUp).Row).Delete
        Wend
    Case False
        While Range("A65536").End(xlUp) < Date + 30
            Rows(Range("A65536").End(xlUp).Row).Copy
        
            Rows(Range("A65536").End(xlUp).Row + 2).Resize(3).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                                                                           False, Transpose:=False
            Range("A65536").End(xlUp).Offset(3, 0) = Range("A65536").End(xlUp) + 1
            
            Application.CutCopyMode = False
            [COLOR=red]'Mise en forme de la dernière ligne du bloc de 3 lignes
            With Range("A65536").End(xlUp).Offset(1)
                With .Resize(1, 46).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With
                'La première cellule de la ligne n'a pas de bordure haute
                .Cells(1, 1).Borders(xlEdgeTop).LineStyle = xlNone
            End With[/COLOR]
        Wend
    End Select
    Application.ScreenUpdating = True
End Sub

A+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
906
TooFatBoy
TooFatBoy
arck
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
644
AtTheOne
AtTheOne
Eric 888
  • Question Question
Microsoft 365 Excel VBA: manipuler des fichiers partagés via Teams / Sharepoint
Réponses
2
Affichages
119
Eric 888
Eric 888
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
427
patricktoulon
patricktoulon
anthoYS
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
612
anthoYS
anthoYS
A
  • Question Question
XL 2019 Copie d'une valeur dans la cellule à côté d'une valeur trouvé
Réponses
1
Affichages
580
sylvanu
sylvanu
D
  • Question Question
XL 2016 Format date
Réponses
3
Affichages
326
dadaze
D
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
3 K
Dranreb
Dranreb
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
789
ph.vanne
ph.vanne
R
  • Question Question
Microsoft 365 Import .txt au format date
Réponses
14
Affichages
583
dysorthographie
dysorthographie
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
29
Affichages
2 K
TooFatBoy
TooFatBoy
U
  • Question Question
Autres RÉSOLU ma macro ne fonctionne pas
Réponses
3
Affichages
268
un internaute
U
S
  • Résolu(e)
XL 2016 Coller nom classeur sur plage cellules
Réponses
9
Affichages
643
safranien
S
C
  • Question Question
Microsoft 365 Lenteur macro mise en page
Réponses
7
Affichages
366
CortoXls
C
E
  • Résolu(e)
Microsoft 365 Reduire Temps Execution Code
Réponses
5
Affichages
485
eric72
E
K
  • Question Question
XL 2016 VBA: Selection Date renvoie copier/coller
Réponses
8
Affichages
1 K
Krome36
K
lynyrd
  • Résolu(e)
XL 2016 Supprimer 1 sur 13
Réponses
6
Affichages
422
lynyrd
lynyrd
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
1 K
telemarrk
T
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
792
Phil69970
Phil69970
X
  • Question Question
XL 2021 Génération word à partir d'excel en gardant le format source
Réponses
8
Affichages
401
xlym
X
Retour