Aprire scheda compilata con specific valori ed immagine

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim wk1 As Worksheet, wkScale As Worksheet, ur As Long, mPath As String, mFoto As String
Dim s As Shape
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wk1 = Worksheets("06-15")
Set wkScale = Worksheets("Scheda Scale")
mPath = ActiveWorkbook.Path
ur = wk1.Range("A" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("A2:A" & ur)) Is Nothing Then
    With wkScale
    .Visible = True
    .Select
    .Range("A2").Select
    End With
    For Each s In ActiveSheet.Shapes
        s.Delete
    Next
    mFoto = mPath & "\" & Target & ".jpg"
    If Dir(mFoto) = "" Then
        mFoto = mPath & "\" & "manca.jpg"
    End If
        With ActiveSheet.Pictures.Insert(mFoto)
        .ShapeRange.LockAspectRatio = msoFalse
        mTop = ActiveCell.Top
        mLeft = ActiveCell.Left
        mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(15).Address).Height
        mWidth = ActiveCell.Width
        .Top = mTop
        .Left = mLeft
        .Width = mWidth
        .Height = mHeight
    End With
End If
Set wk1 = Nothing
Set wkScale = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub