Macro para rellenar figuras con imágenes en serie

Te cambio la macro.

Sub imagen()
'Insertar varias imágenes
'Por.Dam
Dim vrtSelectedItem As Variant
celdainicio = "B1"
'celdainicio = ActiveCell.Address
fila = Range(celdainicio).Row
col = Range(celdainicio).Column
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "                     Seleccione uno o varios archivos"
        .Filters.Clear
        .Filters.Add "archivos jpg", "*.jpg*"
        .Filters.Add "archivos gif", "*.gif*"
        .Filters.Add "All Files", "*.*"
        .FilterIndex = 1
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path
    If .Show Then
        For Each vrtSelectedItem In .SelectedItems
            Cells(fila, col).Select
            ActiveSheet.Pictures.Insert(vrtSelectedItem). _
            Select
            col = col + 1
        Next
    End If
    End With
End Sub

Indicaciones:

- La macro funciona para poner varias imágenes en excel.

- Las empieza a poner en la celda B1, cambia "B1", en esta línea, en la macro, por si quieres que inicie en otra celda

celdainicio = "B1"

- Si quieres que inicie a partir de la celda donde está el cursor de excel, entonces, a esta línea:

'celdainicio = ActiveCell.Address

quítale el apostrofe que está al inicio de la línea, te debe quedar así:

celdainicio = ActiveCell.Address

- La macro empieza a insertar las imágenes en la celda inicio, la siguiente imagen la pone en la celda de la derecha, y así sucesivamente va a poniendo las imágenes hacia la derecha; si quieres que ponga las imágenes hacia abajo, cambia esta línea

col = col + 1

por esta
fila = fila + 1

Saludos. Dam
Si es lo que necesitas.