Sub kartinki_von()
Dim i As Long, i_n As Long
Dim obj As shape
Dim NWS As Worksheet, AWS As Worksheet
Set AWS = ActiveSheet
Set NWS = ActiveWorkbook.Sheets.Add
i_n = AWS.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To i_n
For Each obj In AWS.Shapes
  If obj.Type = 13 Then
    If AWS.Cells(i, 2).Top = obj.BottomRightCell.Top Then
       obj.Copy
       With NWS.ChartObjects.Add(0, 0, obj.Width, obj.Height).Chart
           .ChartArea.Border.LineStyle = 0
           .Paste
           .Export Filename:=ActiveWorkbook.Path & "\" & AWS.Cells(i, 2) & ".jpg", FilterName:="JPG"
           .Parent.Delete
       End With
    End If
  End If
Next obj
Next i
Application.DisplayAlerts = False
NWS.Delete
Application.DisplayAlerts = True
End Sub