position multiple photos over specific cells

Question

I am using the following code to insert multiple images from a folder every 50 cells.

What does the code do ?

1- Open file dialog

2- Import the photos (4 photos per folder)

3- Resize them

4- Insert them in specific location (every 50 cells)

The code is perfectly working so far as it should be.

What is the requested change ?

1- Insert the photos in specific range of cells instead of every 50 cells.

For example:

Photo 1: (A4:B10)

photo 2: (C4:D10)

Photo 3: (E4:F10)

Photo 4: (G4:H10)

It would be great if somebody could help me doing this.

Sub AddPhotos()
    Dim mainWorkBook As Workbook
    Dim fdl As FileDialog
    
    Set mainWorkBook = ActiveWorkbook
    Sheets("Sheet1").Activate
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then Folderpath = .SelectedItems(1)
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Set listfiles = fso.GetFolder(Folderpath).Files
    For Each fls In listfiles
        strCompFilePath = Folderpath & "\" & Trim(fls.Name)
        If strCompFilePath <> "" Then
            If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
               Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
               Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
                counter = counter + 50
                
                Sheets("Sheet1").Range("A" & counter).ColumnWidth = 10
                Sheets("Sheet1").Range("A" & counter).RowHeight = 15
                Sheets("Sheet1").Range("A" & counter).Activate
                Call insert(strCompFilePath, counter)
                Sheets("Sheet1").Activate
            End If
        End If
    Next
    mainWorkBook.Save
End Sub

Function insert(PicPath, counter)
    MsgBox PicPath
    With ActiveSheet.Pictures.insert(PicPath)
        With .ShapeRange
            .LockAspectRatio = msoFalse
            .Width = 465
            
            .Height = 450
        End With
        .Left = ActiveSheet.Range("A" & counter).Left
        .Top = ActiveSheet.Range("A" & counter).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function

Answer 1

Now I understand the requirement, here is the way I'd build your routine. I've created a function that locates the top left cell of the bottom-most image loaded; in run-time, so there is no need to store the value for next time. It merely finds the bottom-most image and loads the next picture 50 rows below that.

Sub AddPhotos()
    Dim mainWorkBook As Workbook
    Dim fdl As FileDialog
    Set mainWorkBook = ActiveWorkbook
    Sheets("Sheet1").Activate
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then Folderpath = .SelectedItems(1)
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Set listfiles = fso.GetFolder(Folderpath).Files
    For Each fls In listfiles
        strCompFilePath = Folderpath & "\" & Trim(fls.Name)
        If strCompFilePath <> "" Then
            If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
               Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
               Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
                Call insert(strCompFilePath)
            End If
        End If
    Next
    
    mainWorkBook.Save
End Sub

Function insert(PicPath)

    destination_row = last_image_row + 50
    If destination_row = 50 Then destination_row = 4
    
    With ActiveSheet.Pictures.insert(PicPath)
        With .ShapeRange
            .LockAspectRatio = msoFalse
            .Width = 465
            .Height = 450
        End With
        .Left = ActiveSheet.Cells(destination_row, 1).Left
        .Top = ActiveSheet.Cells(destination_row, 1).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function

Function last_image_row() As Long
    last_image_row = 0
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture And shp.TopLeftCell.Row > last_image_row Then last_image_row = shp.TopLeftCell.Row
    Next
End Function