Help with pasting picture MACRO

[alekun86]

Hi!
I would like some help in order to change the range of action of a paste picture macro

I would like to paste photo in range:
- L17:U17 based on the value from L3:U3
- L40:U40 based on the value from L27:U27
- L63:U63 based on the value from L50:U50
- L86:U86 based on the value from L73:U73
- L109:U109 based on the value from L96:U96
- L132:U132 based on the value from L119:U119
- L155:U155 based on the value from L142:U142
- L178:U178 based on the value from L165:U165
- L203:U203 based on the value from L190:U190

here the function:

Option Explicit

Sub InsertPicture()
Dim ws As Worksheet
Dim LastRow As Long
Dim x As Long
Dim cPic As Shape

'~~> Set this to the relevant worksheet
'~~> Use Code Name if possible
Set ws = ThisWorkbook.Sheets("Sheet1")

With ws
'~~> Find the last row. Fully qualify the Range and the Rows Object
'~~> by adding a DOT before it
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row

'~~> Loop through the row. No need to select the cell where the paste
'~~> is going to happen. You are handling that later
For x = 2 To LastRow
'~~> Check if the cell in B is not empty
If Len(Trim(.Cells(x, 2).Value2)) <> 0 Then
'~~> Insert the shape
Set cPic = .Shapes.AddPicture("C:\Users\90009672\Desktop\baba\" & _
.Cells(x, 2).Value2 & _
".jpg", False, True, 10, 10, 10, 10)

'~~> Customize the shape values
With cPic
.LockAspectRatio = msoFalse

.Height = 80
.Width = 80

.Left = ws.Cells(x, 1).Left + ws.Cells(x, 1).Width / 2 - .Width / 2
.Top = ws.Cells(x, 1).Top + ws.Cells(x, 1).Height / 2 - .Height / 2
End With
End If
Next x
End With
End Sub



Thank you