Sub Вставка2()
Dim i&, r As Range, shp As Shape
    For i = 4 To 393
        Set r = Sheets(2).Cells.Find(Cells(i, 3).Value, LookAt:=xlWhole)
        For Each shp In Sheets(2).Shapes
            If shp.TopLeftCell.Address = r.Next.Address Then
                shp.Copy
                Cells(i, 2).PasteSpecial xlPasteAll
            End If
        Next
    Next
Dim sh As Shape, ph#, pw, ch#, cw#, px#, py#
      For Each sh In ActiveSheet.Shapes
    If sh.Type = msoDiagram Then sh.Select False
    ph = sh.Height: pw = sh.Width
    ch = sh.TopLeftCell.MergeArea.Height: cw = sh.TopLeftCell.MergeArea.Width
    px = sh.TopLeftCell.MergeArea.Left + (cw - pw) / 2
    py = sh.TopLeftCell.MergeArea.Top + (ch - ph) / 2
    sh.Left = px
    sh.Top = py
      Next
End Sub