Copier la ligne supérieur en fonction de la cellule active

Bonjour à tous,

Après des recherches sur le forum, je bloque sur un code :

Je ne sais pas si c'est possible mais j'aimerai copier les valeurs de la ligne supérieures (uniquement celle dans les colonnes A, D à F, H et K) par rapport à la cellule active et quand je suis dans la colonne B.

Le problème c'est que j'ai des lignes fusionnées...

Merci pour votre aide.

Michael

Sub Copier()

With ActiveCell
    'Rows(.Row - 1 & ":" & .Row - 2).Copy
    Rows(.Row - 2).Copy Rows(.Row)
    Rows(.Row - 1).Copy Rows(.Row + 1)
End With

End Sub

J'ai enfin trouvé une solution, elle n'est pas forcément optimisée...

Sub Copier_valeur()
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Range("A" & (ActiveCell.Row - 1)).Select
    Selection.Copy 
    Range("A" & (ActiveCell.Row + 2)).Select
    Selection.PasteSpecial Paste:=xlPasteValues

    Range("D" & (ActiveCell.Row - 1), "F" & (ActiveCell.Row - 1)).Select 
    Selection.Copy 
    Range("D" & (ActiveCell.Row + 2), "F" & (ActiveCell.Row + 2)).Select
    Selection.PasteSpecial Paste:=xlPasteValues

    Range("H" & (ActiveCell.Row - 1)).Select
    Selection.Copy 
    Range("H" & (ActiveCell.Row + 2)).Select
    Selection.PasteSpecial Paste:=xlPasteValues

    Range("K" & (ActiveCell.Row - 1)).Select
    Selection.Copy 
    Range("K" & (ActiveCell.Row + 2)).Select
    Selection.PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False
    Range("B" & (ActiveCell.Row)).Select

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

Bonjour Mika25,

Un essai ... sans bouger la cellule active et sans utiliser les "Select" ...

Plus besoin d'être en colonne B ... c'est la ligne qui compte de "A" à "K" (à l'exception des colonnes " C " et " i ") ...

Sub Copier_valeur()
Dim Cr As Integer     ' définir une variable

Cr = ActiveCell.Row    ' la valeur de la variable prend le numéro de ligne de la cellule active 

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Range("A" & Cr - 2 & ":A" & Cr - 1).Copy
    Range("A" & Cr).PasteSpecial Paste:=xlPasteValues

    Range("D" & Cr - 2 & ":F" & Cr - 1).Copy
    Range("D" & Cr & ":F" & Cr).PasteSpecial Paste:=xlPasteValues

    Range("H" & Cr - 2 & ":H" & Cr - 1).Copy
    Range("H" & Cr).PasteSpecial Paste:=xlPasteValues

    Range("K" & Cr - 2 & ":K" & Cr - 1).Copy
    Range("K" & Cr).PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False
    Range("B" & Cr).Select

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

ric