Code:Sub Save_PDF_Papers_5()
'(ByVal fname As String) '--------------------------------------
'DECLARE AND SET VARIABLES
Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range
Dim d As Object, p2 As String, count As Long
Dim LastRow As Long, fn As String, rn
Dim wsM As Worksheet, wsC As Worksheet, i As Long
'Dim fso As Object, pf as object 'Late Binding
Dim fso As FileSystemObject, pf As Folder 'Early Binding
p2 = "C:\Users\test\Documents\"
'p2 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
'Set objects
Set wsM = Worksheets("Main")
Set wsC = Worksheets("Candidate")
Set rng1 = wsM.Range("D5", wsM.Cells(Rows.count, "D").End(xlUp))
Set rng2 = wsC.Range("B2", wsC.Cells(Rows.count, "B").End(xlUp))
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
'CREATE INDIVIDUAL FOLDERS
If Not .FolderExists(p2 & "Files") Then _
.GetFolder(p2).SubFolders.Add "Files"
If Not .FolderExists(p2 & "Files\Paper") Then _
.GetFolder(p2 & "Files").SubFolders.Add "Paper"
p2 = p2 & "Files\Paper\"
Set pf = .GetFolder(p2)
'Iterate each candidate reference to update Main sheet.
For i = 1 To rng2.Rows.count
wsM.[F1] = rng2(i).Offset(, -1) 'Reference number for candidate
rn = Trim(wsM.[F1])
count = 1
'Iterate each file item and copy files and make pdf for candidate.
For Each c1 In rng1
If c1.Offset(, 3) <= 0.5 And count <= 5 Then
If .FileExists(c1) Then
.CopyFile c1, p2 & rn & "." & .GetFileName(c1), False
count = count + 1
End If
End If
Next c1
wsM.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
p2 & rn & "." & Trim(wsM.[c2]) & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
End With
'--------------------------------------
'CLEANUP
Set pf = Nothing
Set fso = Nothing
MsgBox "All done..."
End Sub