Simplification VBA pour copier-coller

Bonjour à tous,

J'ai une macro qui me permet d'insérer une ligne et de copier les formules de calcul des cellules des colonnes N,O,P,Q.sur la nouvelle ligne.

Toutefois étant débutant et ne maitrisant pas le vba j'ai adapté une macro qui fonctionne mais qui est trop "volumineuse".

J'aurai donc besoin de votre aide afin de la simplifier :

 Sub AjouterLigne()

Dim r As Integer

r = ActiveCell.Row
Rows(r).Select

If MsgBox("Voulez-vous ajouter une ligne ?", _
                    vbYesNo + vbQuestion + vbDefaultButton2, "Ajout") = vbYes Then

    Selection.Insert Shift:=xldwon

    Range("b" & r).Interior.ColorIndex = 2

    If Range("Q" & r - 1) <> "" Then
    Range("N" & r - 1).Select
    Selection.Copy
    Range("N" & r).Select
    ActiveSheet.Paste
    Else
    Range("N" & r - 3).Select
    Selection.Copy
    Range("N" & r).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If

        If Range("q" & r - 1) <> "" Then
        Range("O" & r - 1).Select
        Selection.Copy
        Range("O" & r).Select
        ActiveSheet.Paste
        Else
        Range("O" & r - 3).Select
        Selection.Copy
        Range("O" & r).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        End If
....

Je joins un bout de mon fichier avec le code complet de la macro "AjouterLigne"

par avance merci

Cordialement

Stéphane

Bonjour,

un proposition de simplification du code

Sub AjouterLigne()
    Dim r As Integer
    r = ActiveCell.Row
    If MsgBox("Voulez-vous ajouter une ligne ?", _
              vbYesNo + vbQuestion + vbDefaultButton2, "Ajout") = vbYes Then
        Rows(r).Insert Shift:=xlDown
        Rows( r).Interior.ColorIndex = 2
        If Range("Q" & r - 1) <> "" Then
            Range("N" & r - 1 & ":Q" & r -1).Copy Range("N" & r)
        End If
    End If
End Sub

Bonjour

Bonjour h2so4

A voir

Sub AjouterLigne()
Dim Ligne As Long

  If ActiveCell.Interior.ColorIndex <> 15 Then
    MsgBox "Vous n'êtes pas sur une ligne grisée"
    Exit Sub
  End If

  If MsgBox("Voulez-vous ajouter une ligne ?", _
            vbYesNo + vbQuestion + vbDefaultButton2, "Ajout") <> vbYes Then Exit Sub

  Ligne = ActiveCell.Row

  Range("A" & Ligne - 1 & ":Q" & Ligne - 1).Copy
  Range("A" & Ligne & ":Q" & Ligne).Insert shift:=xlShiftDown
  With Range("A" & Ligne & ":Q" & Ligne)
    On Error Resume Next
    .SpecialCells(xlCellTypeConstants, 23).ClearContents
    On Error GoTo 0
    .Interior.ColorIndex = xlNone
  End With
  Application.CutCopyMode = False
End Sub

Bonsoir le forum

Bonsoir Banzai64, H2so4, merci pour vos réponses.

H2so4 la macro est vraiment top. Elle s'exécute très rapidement et tiens en peu de ligne.

Banzai64 la macro marche bien sur la première condition mais je n'ai pas réussi à l'adapter selon la condition qui est présente dans ma macro.

Par contre le début de la macro est d'un grand intérêt car effectivement il est préférable d'obliger l'utilisateur de sélectionner une cellule grisée.

Je vais donc mixer les deux codes et je vais tenter de tester et de faire fonctionner la deuxième solution également.

Merci à vous deux, bonne soirée

Cordialement

Stéphane