Microsoft 365 Macro pour copier des lignes et les coller à l'emplacement de la cellule sélectionnée

[Fanou44]

Bonjour à tous,

J'espère que ma question sera suffisamment précise !

Dans mon tableau, je souhaite pouvoir sélectionner une cellule (ce sont les cellules identifiées en JAUNE dans mon fichier), puis, lorsque je lance une macro, cette macro réalise les actions suivantes :

- Elle copie 2 lignes qui sont dans l'entête du tableau (ce sont des lignes pré-formatées et mise en forme comme je le souhaite) : correspond aux lignes 1 et 2 de mon fichier ;

- Elle insère ces 2 lignes aux dessus de la cellule que j'ai sélectionnée (cellule JAUNE sur mon fichier).

Les cellules jaunes correspondent en fait aux endroits où l'utilisateur pourra ajouter des lignes au tableau. Ceci permet de me garantir que les lignes ajoutées seront intégrées dans les plages des formules.

Ne vous inquiétez pas, mon fichier en pièce jointe ne présente aucun risque, il ne contient aucune macro.

Un énorme merci d'avance pour l'aide que vous pourrez m'apporter.

Bon week-end à tous, et bravo pour ces belles compétences que vous avez et que j'aimerais avoir aussi

 

[sylvanu]

Bonsoir Fanou, et bienvenu sur XLD,
Que de cellules fusionnées inutiles ! Je pense que vous auriez pu vous en passer.
Un essai en PJ avec :

Sub InsertionLignes()
    Application.ScreenUpdating = False
    If ActiveCell.Interior.Color <> RGB(255, 255, 0) Then Exit Sub  ' Si pas jaune on sort
    Ligne = ActiveCell.Row                                          ' Récupération N° de ligne cliquée
    For i = 1 To 3                                                  ' Insertion de trois lignes
        Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next i
    Rows(Ligne - 1).Select                                          ' Copy paste ligne soulignée
    Application.CutCopyMode = False: Selection.Copy
    Rows(Ligne + 2).Select: ActiveSheet.Paste
    Range("G1:R2").Select                                           ' Copy paste entete
    Application.CutCopyMode = False: Selection.Copy
    Range("G" & Ligne).Select: ActiveSheet.Paste
    Range("J" & Ligne).Select
End Sub

Si la cellule sélectionnée n'est pas jaune, on ne fait rien.

 

[Fanou44]

Sylvanu, quel génie !!!
Ca marche parfaitement et répond exactement à ce que je recherchais.

Merci encore, et merci à XLD d'exister !