Sub AddOlEObject()

    Dim mainWorkBook As Workbook

    Set mainWorkBook = ActiveWorkbook
    
    For i = 2 To ThisWorkbook.Sheets.Count
    
    With Sheets(i)
        
    Sheets(i).Activate
    
    Folder = Range("H2")
    
    Folderpath = Folder '
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    NoOfFiles = fso.GetFolder(Folder).Files.Count
    
    Set listfiles = fso.GetFolder(Folderpath).Files
    
    For Each fls In listfiles
       
       strCompFilePath = Folder & "\" & 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 + 25
                Call insert(strCompFilePath, counter - 15)
                Sheets(i).Activate
            End If
        End If
    Next
mainWorkBook.Save
End With
Next
End Sub

Function insert(PicPath, counter)
    
    With ActiveSheet.Pictures.insert(PicPath)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 200
            .Height = 375
        End With
        .Left = ActiveSheet.Range("B" & counter).Left
        .Top = ActiveSheet.Range("B" & counter).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function