Place picture in a targetsheet in one row

Option Explicit
Global cnt As Integer

Sub Main()

    Range("A:O").ClearContents
    
        Range("A1:O1").Select
    With Selection
        .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Font
        .Name = "Calibri"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    ActiveCell.FormulaR1C1 = "MOULD STATUS OVERVIEW"
    Range("A2:O2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = 0
        .PatternTintAndShade = 0
   
        
    End With
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Item"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Toolmaker"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Tool Number"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Customer"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Project"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Part"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "Mould Layout"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Part Name 1"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "Part Number 1"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "Part Name 2"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "Part Number 2"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "Current Status"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "Finish Date"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "T1 Trial Date"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "Mould Live Book"
    
    
    cnt = 3
    Recurse ("C:\Folder\")
    
    MsgBox ("Klaor!")

End Sub


Function Recurse(folder As String)

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim Toolmaker As String
    Dim Toolnr As String
    Dim Customer As String
    Dim Project As String
    Dim Mouldlayout As String
    Dim Partname As String
    Dim Partnr As String
    Dim Partname2 As String
    Dim Partnr2 As String
    Dim Currentstat As String
    Dim Finishdate As String
    Dim T1trialdate As String
            
    Dim FSO As Object
    Dim baseFolder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim found As Range
    Dim plaatje As PictureFormat
            
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set baseFolder = FSO.GetFolder(folder)
    
    For Each subFolder In baseFolder.Subfolders
        
        For Each file In subFolder.Files
                      
            If (InStr(file.Name, "Mould Live Book") > 0) Then
            
                                        
                Range("A" & cnt).Value = (cnt - 2)
                Range("O" & cnt).Value = subFolder & "\" & file.Name
                                                                                                                          
                Application.ScreenUpdating = False
                Application.DisplayAlerts = False
                            
                Set wb = Workbooks.Open(file.Path)
                Set ws = wb.Sheets(1)
                Set ws2 = wb.Sheets(2)
                            
                Toolmaker = ws.Range("J4").Value
                Toolnr = ws.Range("J7").Value
                Customer = ws.Range("E4").Value
                Project = ws.Range("E5").Value
                
                Mouldlayout = ws.Range("E56").Value
                Partname = ws.Range("E13").Value
                Partnr = ws.Range("E15").Value
                Partname2 = ws.Range("E14").Value
                Partnr2 = ws.Range("E16").Value
                Currentstat = ws2.Range("N3").Value
                Finishdate = ws2.Range("Z3").Value
                T1trialdate = ws2.Range("D16").Value
                
                Range("D16:D108").Select
                Selection.Find(What:="Trial Date", After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate
                
                'Hyperlink = ws.Range("E16").Value
                
                'plaatje = ws.Range("J13:M23").CopyPicture

                'found = ws2.Columns("D").Find(what:=("Trial Date"), LookIn:=xlValues, lookat:=xlWhole)
                'found = wb.Sheets(2).Columns("D").Find(what:=("Trial Date"), LookIn:=xlValues, lookat:=xlWhole)
         
                             
                wb.Close

                
                ActiveWorkbook.Sheets(1).Range("B" & cnt).Value = Toolmaker
                ActiveWorkbook.Sheets(1).Range("C" & cnt).Value = Toolnr
                ActiveWorkbook.Sheets(1).Range("D" & cnt).Value = Customer
                ActiveWorkbook.Sheets(1).Range("E" & cnt).Value = Project
               'ActiveWorkbook.Sheets(1).Range("F" & cnt).Value = plaatje
                ActiveWorkbook.Sheets(1).Range("G" & cnt).Value = Mouldlayout
                ActiveWorkbook.Sheets(1).Range("H" & cnt).Value = Partname
                ActiveWorkbook.Sheets(1).Range("I" & cnt).Value = Partnr
                ActiveWorkbook.Sheets(1).Range("J" & cnt).Value = Partname2
                ActiveWorkbook.Sheets(1).Range("K" & cnt).Value = Partnr2
                ActiveWorkbook.Sheets(1).Range("L" & cnt).Value = Currentstat
                ActiveWorkbook.Sheets(1).Range("M" & cnt).Value = Finishdate
                ActiveWorkbook.Sheets(1).Range("N" & cnt).Value = T1trialdate
                'ActiveWorkbook.Sheets(1).Range("O" & cnt).Value = Hyperlink
            
                'ActiveWorkbook.Sheets(1).Range("G" & cnt).Value = found
                'indien zoeken in range D van tabblad2 trial date, dan de datum erachter pakken
                
                
                Application.ScreenUpdating = True
                Application.DisplayAlerts = True
                
                cnt = cnt + 1
                
                End If
                    
        Next
        
        Recurse = Recurse(subFolder.Path)
    
    Next
        
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Function