inserting multiple images at a time

hello

I have an excel sheet where column B should have pictures in each cell. I also have a folder with pictures numbered in serial . I would like to place the picture of each product in column B beside their respective codes.
Can some one help with it please.
Attached is my excel sheet

Hi

change the path accordingly


Sub AutoInsertPic()

ChDir "D:\pic" 'give correct path

For x = 3 To Range("A1000").End(xlUp).Row Step 2
Picpath = "D:\pic\" & Range("A" & x) & ".jpg"
Range("B" & x).Select
With ActiveSheet.Pictures.Insert(Picpath)
.Width = Cells(x, 2).Width
'.Height = Cells(x, 2).Height

.Left = Cells(x, 2).Left
.Top = Cells(x, 2).Top
.Placement = 1
.PrintObject = True

End With


Next x
End Sub

Thank you...
Where shall i include this code?
When i click on the cell to choose the
Pic will it automatically put the pics in the cells?

Hi

click Alt F11 (assume you are in the excel file)
insert>module

then copy the modifed below code into the module

'---------------------
Sub AutoInsertPic()
Dim FolderName As String

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
FolderName = .SelectedItems(1)
For x = 3 To Range("A1000").End(xlUp).Row Step 2
Picpath = FolderName & "\" & Range("A" & x) & ".jpg"
Range("B" & x).Select
On Error Resume Next
With ActiveSheet.Pictures.Insert(Picpath)
.Width = Cells(x, 2).Width
'.Height = Cells(x, 2).Height

.Left = Cells(x, 2).Left
.Top = Cells(x, 2).Top
.Placement = 1
.PrintObject = True

End With

Next x
End If
End With
End Sub

'-----------------------

close the window to return to Excel.

click ALT F8 (to run the code)
select AutoInsertPic and Run the code

i tried the code you wrote , when i click to insert the picture it will open me the dialog box and i cannot see the .jpg pictures to choose.

Hi

when the dialog box opens, select the only the folder, then all the picture file in the folder will insert in the specified cell.