XL 2016 Copier et coller une plage en image

Sub copyImg(rng As Range, rng2 As Range)
     rng.copy: rng.Parent.Pictures.Paste
      Set shap = rng.Parent.Pictures(rng.Parent.Pictures.Count)
       shap.ShapeRange.Fill.Visible = True ' opacifie les partie transparentes de l'image
      d = GetDimPositionShapeCenterRange(rng2, shap)

    'on place et dimentionne l'image dans la plage de destination
    With shap
        .Left = d(0)
        .Top = d(1)
        .Width = d(2)
        .Height = d(3)
        .ShapeRange.Line.Visible = True    'pour que l'on puisse bien voir sa position dans la plage de cellule
    End With
End Sub


Function GetDimPositionShapeCenterRange(rng As Range, shap, Optional PercentMarge As Long = 100, Optional NoRedim As Boolean = False)    'la marge exprime un pourcentage de 1 à x%
'collection fonctions perso Catégorie [IMAGES] by patricktoulon sur exceldownloads
    Dim Ratio#, Wx#, Hy#, Tp#, LfT#
    Ratio = Application.Min(rng.Width / shap.Width, rng.Height / shap.Height)
    If NoRedimXY Then Ratio = 1: PercentMarge = 100
    Wx = (shap.Width * Ratio) * (PercentMarge / 100)
    Hy = (shap.Height * Ratio) * (PercentMarge / 100)
    Tp = rng.Top + ((rng.Height - Hy) / 2)
    LfT = rng.Left + ((rng.Width - Wx) / 2)
    GetDimPositionShapeCenterRange = Array(LfT, Tp, Wx, Hy)
End Function

Sub Grille(x)
Cells(1).Resize(x, x).ColumnWidth = 0.08
Cells(1).Resize(x, x).RowHeight = 0.75
End Sub
Sub test()
Grille Asc("Staple") + 1517
End Sub

Sub test()
    sizeToCARRE [A1:F10], 30
End Sub
Function sizeToCARRE(Rng, taille)
    With Rng.Cells(1)
        .ColumnWidth = taille / 2
        .RowHeight = taille * 2
        Do While .Height > 30 And .Width > 30
            If .Width > 30 Then .ColumnWidth = .ColumnWidth - 0.1
            If .Height > 30 Then .RowHeight = .RowHeight - 0.1
        Loop
   With Rng
   .RowHeight = Rng.Cells(2).RowHeight
   .ColumnWidth = Rng.Cells(2).ColumnWidth
   End With
   End With

End Function