Images

Copy Cell with Images to Same or antoher Sheet

Sub Test()
    Dim sourceRange As Range
    Set sourceRange = Sheet1.Range("E2:E12")

    Dim targetRange As Range
    Set targetRange = Sheet1.Range("E21")

    Dim i As Integer, rowId As Integer
    rowId = 1
    For i = 1 To sourceRange.Cells.Count

        'Code to Copy Cell with image
        Sheet1.Activate
        sourceRange.Cells(i, 1).Select
        Selection.Copy

        'Code to Paste Cell with image
        Sheet1.Activate
        targetRange.Cells(rowId, 1).Select
        Sheet1.Paste

        rowId = rowId + 1
    Next
    Application.CutCopyMode = False
End Sub

Code to Check if cell contain image

Sub CheckIfCellContainPic()
    Dim sourceRange As Range
    Set sourceRange = Sheet1.Range("D16")

    Dim images As New Dictionary
    Dim shape As shape
    For Each shape In Sheet1.Shapes
        'Debug.Print shape.TopLeftCell.Address
        If Not images.Exists(shape.TopLeftCell.Address) Then
            images.Add shape.TopLeftCell.Address, shape.Name
        End If
    Next

    Debug.Print IsCellContainPic(sourceRange, images)
End Sub

Private Function IsCellContainPic(cell As Range, images As Dictionary) As Boolean
    If cell.Count = 1 Then
        IsCellContainPic = images.Exists(cell.Address)
    End If
End Function