Autres Copie dans le presse-papier d'une sélection multiple

Dim mem1, mem2 'mémorise les variables

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count <> 2 Then Exit Sub
Dim n, test1 As Boolean, test2 As Boolean
For n = 1 To 2
    If Target.Areas(n).Count = 28 And Target.Columns.Count = 1 Then test1 = True: mem1 = Target.Areas(n)
    If Target.Areas(n).Count = 1 Then test2 = True: mem2 = Target.Areas(n)
Next
If Not test1 And test2 Then mem1 = Empty
End Sub

Sub Coller()
'se lance par les touches Ctrl+M
If IsEmpty(mem1) Then Exit Sub
ActiveCell.Resize(28) = mem1
ActiveCell(32, 2) = mem2
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
CommandBars("Cell").Reset
End Sub

Private Sub Workbook_Open()
additemmenucell
End Sub

Private Sub Workbook_Activate()
additemmenucell
End Sub

Private Sub Workbook_Deactivate()
Application.CommandBars("Cell").Controls(2).Enabled = True
End Sub

Sub additemmenucell()
   Dim bout As CommandBarControl
   With CommandBars("Cell")
        .Reset
        Set bout = .Controls.Add(msoControlButton, , , 1, True)
        With bout
            .Caption = "copier la colonne"
            .FaceId = 5378
            .OnAction = ThisWorkbook.Name & "!copyspecial"
        End With
        Set bout = .Controls.Add(msoControlButton, , , 2, True)
        With bout
            .Caption = "coller la copie"
            .FaceId = 5378
            .OnAction = ThisWorkbook.Name & "!collespecial"
       .Enabled = False
       End With

    End With
End Sub

Sub copyspecial()
    MsgBox "on copie"
End Sub
Sub collespecial()
    MsgBox "on colle"
End Sub