Evenement après un coller

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim C As String, I As Long
    With Application.CommandBars("Standard")
        I = .FindControl(ID:=128).Index
        C = .Controls(I).List(1)
    End With
    If C = "Coller" Then Macro1
End Sub

Option Explicit

Sub Macro1()
Dim Presse_Papier As String
    'on annule le coller
    With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
    End With
    'on récupère le contenu du presse-papier
    Presse_Papier = GetPressPapier
    'Modification des colonnes
    MsgBox Presse_Papier
End Sub

Function GetPressPapier() As String
'http://excel.developpez.com/faq/?page=PressePapier#RecupPressePapier
'nécessite d'activer la référence "Microsoft Forms 2.0 Object Library."
 
    With New dataObject
        .GetFromClipboard
        GetPressPapier = .GetText(1)
    End With
End Function

Option Explicit

Private Sub Workbook_Open()
    Call ActiveCollerSpecial
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim C As String, i As Long

    If CollerSpecialActif Then
        With Application.CommandBars("Standard")
            i = .FindControl(ID:=128).Index
            C = .Controls(i).List(1)
        End With
        If C = "Coller" Then Macro1
    End If
End Sub

Option Explicit
Option Base 0

Public CollerSpecialActif As Boolean

Sub ActiveCollerSpecial()
    CollerSpecialActif = True
End Sub

Sub DesactiveCollerSpecial()
    CollerSpecialActif = False
End Sub

Sub Macro1()
Dim Donnees As Variant, NbDim As Integer
Dim strTexte As String

    'on annule le coller
    With Application
        .EnableEvents = False
        .Undo
        'on récupère le contenu du presse-papier
        strTexte = GetPressPapier
        'calcul du nombre de dimensions du tableau à créer :
        NbDim = InStr(strTexte, Chr(13) & Chr(10))
        If NbDim = 0 Then
            Donnees = Split(strTexte, Chr(9))
            Restitue Donnees, 1
        Else
            Donnees = Fait_Tableau(strTexte)
            Restitue Donnees, 2
        End If
        .EnableEvents = True
        .CutCopyMode = False
    End With
    Cells(ActiveCell.Row, 1).Select
End Sub

Function GetPressPapier() As String
'http://excel.developpez.com/faq/?page=PressePapier#RecupPressePapier
'nécessite d'activer la référence "Microsoft Forms 2.0 Object Library."
 
    With New dataObject
        .GetFromClipboard
        GetPressPapier = .GetText(1)
    End With
End Function

Function Fait_Tableau(strPp As String) As Variant()
Dim TB_Temp As Variant, Lignes As Variant, Temp As Variant, i As Long, J As Long

    Lignes = Split(strPp, vbCrLf)
    ReDim TB_Temp(0 To UBound(Lignes) - 1, 0 To UBound(Split(Lignes(0), Chr(9))))
    For i = LBound(Lignes) To UBound(Lignes)
        Temp = Split(Lignes(i), Chr(9))
        For J = LBound(Temp) To UBound(Temp)
            TB_Temp(i, J) = Temp(J)
        Next J
    Next
    Fait_Tableau = TB_Temp
    Erase TB_Temp
End Function

Sub Restitue(Tb As Variant, dimens As Integer)
Dim ColRemplac As Variant, i As Long, J As Long

    ColRemplac = Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 17, 18)
    Select Case dimens
        Case 1
            For i = LBound(Tb, 1) To UBound(Tb, 1)
                Cells(ActiveCell.Row, ColRemplac(i)) = Tb(i)
            Next i
        Case 2
            For i = LBound(Tb, 1) To UBound(Tb, 1)
                For J = LBound(Tb, 2) To UBound(Tb, 2)
                    Cells(ActiveCell.Row + i, ColRemplac(J)) = Tb(i, J)
                Next J
            Next i
    End Select
End Sub

Sub SOS()
    Application.EnableEvents = True
End Sub