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
Coller 'lance la macro
End Sub

Sub Coller()
Dim a$, xlApp As Object
If IsEmpty(mem1) Then Exit Sub
a = InputBox("Cellule de destination dans Classeur2 :", , "D48")
If a = "" Then Exit Sub
Set xlApp = CreateObject("Excel.Application") 'nouvelle instance
xlApp.Visible = True
With xlApp.Workbooks.Open(ThisWorkbook.Path & "\Classeur2.xlsm").Sheets(1).Range(a)
    .Resize(28) = mem1
    .Cells(32, 2) = mem2
End With
xlApp.ActiveWindow.WindowState = xlMaximized
AppActivate xlApp.Caption
End Sub