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- I want to Run the code for 2 times to add photo from the first and then the second folder. How to start inserting photos for the second run from rows 250 and each 50 rows on. For example row 250, 300, 350, 400

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