Dim rng As Range
For Each rng In Worksheets("Лист1").UsedRange
    If rng.Locked = False Then rng = Worksheets("Temp").Range(rng.Address)
Next

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call myAdd
End Sub
Private Sub Workbook_Open()
    Sheets("Лист1").Select
    Call myDel
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "Лист1" Then Call myAdd
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If Sh.Name = "Лист1" Then Call myDel
End Sub

Sub myPaste()
    Dim xlAp As New Excel.Application
    Dim xlWb As New Excel.Workbook
    Dim xlSh As New Excel.Worksheet
    Dim rgn As Range
    Dim NumRow As Currency, r As Currency
    Dim NumCol As Integer, c As Integer
    Dim tmp As Range
    On Error Resume Next
    Set tmp = ActiveCell
    Set xlWb = xlAp.Workbooks.Add
    Set xlSh = xlWb.Sheets( 1 )
    xlSh.Paste
    Set rgn = xlSh.UsedRange
    NumRow = rgn.Rows.Count
    NumCol = rgn.Columns.Count
    For r =  0  To NumRow -  1 
        For c =  0  To NumCol -  1 
            If tmp.Offset(r, c).Locked = False Then
                tmp.Offset(r, c) = rgn.Cells(r +  1 , c +  1 )
            End If
        Next c
    Next r
    Set rgn = Nothing
    Set xlSh = Nothing
    xlWb.Close False
    xlAp.Quit
    
    Set xlWb = Nothing
    Set xlAp = Nothing
    Set tmp = Nothing
    
End Sub
Sub myAdd()
    Dim a As Integer, b As Integer
    Dim c As CommandBarControl
    On Error Resume Next
    ' установка макроса в меню
    a = Application.CommandBars( 1 ).FindControl(ID:= 30003 ).Index
    For Each c In Application.CommandBars( 1 ).Controls(a).Controls
        If c.ID =  22  Then b = c.Index
    Next
    'установка макроса в контекстном меню
    Application.CommandBars( 1 ).Controls(a).Controls(b).OnAction = "myPaste"
    For Each c In Application.CommandBars("cell").Controls
        If c.ID =  22  Then b = c.Index
    Next
    Application.CommandBars("cell").Controls(b).OnAction = "myPaste"
    'присвоение макроса комбинации клавишь
    Application.OnKey "^v", "myPaste"

End Sub

Sub myDel()
    Dim a As Integer, b As Integer
    Dim c As CommandBarControl
    On Error Resume Next
    a = Application.CommandBars( 1 ).FindControl(ID:= 30003 ).Index
    For Each c In Application.CommandBars( 1 ).Controls(a).Controls
        If c.ID =  22  Then b = c.Index
    Next
    Application.CommandBars( 1 ).Controls(a).Controls(b).OnAction = ""
    For Each c In Application.CommandBars("cell").Controls
        If c.ID =  22  Then b = c.Index
    Next
    Application.CommandBars("cell").Controls(b).OnAction = ""
    Application.OnKey "^v", ""
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call myDel
End Sub
Private Sub Workbook_Open()
    Sheets("Лист1").Select
    Call myAdd
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "Лист1" Then Call myAdd
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If Sh.Name = "Лист1" Then Call myDel
End Sub