Copy/Paste files into new folders based on condition

Hi

New to Excel VBA and was hoping someone could help.

I am trying to create a macro wherein 20 folders are created (names of folders are from the range of cells e.g. B2:B21). This seems to work OK.

I am then trying to copy 5 (different) pdf files (which are chosen according to a criteria ie. score of <=50%) into each of the 20 folders. This bit is not working properly and I think it's because the cell.Value (which contains the pdf location) is just a file path so the actual physical pdf is not being copied? Please see code below.

Can anyone help me with copying the relevant pdf files across into each of the 20 folders. Or alternative could be that all 5x20=100 pdfs are copied into 1 folder but sorted in some way so I know which pdfs belong to which candidate?

I've attached my files also. Would really appreciate any help here as I'm not sure I am doing this correctly.

Also I've commented out the shell call which I know you can use to print ... but I need copy/paste into new folders instead.

Code:

---

'CREATE INDIVIDUAL FOLDERS
On Error Resume Next
For Each cell In rng2
FldrName = cell
MkDir "C:\Users\test\Documents\Files" & FldrName
Next cell
'COPY PDF FILES IN COLUMN D TO CREATED FOLDERS
For Each cell In rng1
If cell.Offset(0, 3) <= 0.5 And count <= 5 Then
If Not dnary.Exists(cell.Value) Then
dnary.Add cell.Value, 1
FileCopy cell.Value, "C:\Users\test\Documents\Files" & FldrName
'Call apiShellExecute(Application.hwnd, "print", cell.Value, vbNullString, vbNullString, 0)count = count + 1
End If
End If
Next cell

---

Welcome to the forum!

I am not sure about some things.

1. Had to use Trim() as subfolders had space character at end.
2. Check that ActiveSheet is approriate for lastrow.
3. Look at logic for the count counter of 5.

In any case, this should get you close...

Code:

---

Sub Save_PDF_Papers_2() 
  '(ByVal fname As String)  '--------------------------------------
  'DECLARE AND SET VARIABLES
  Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range
  Dim dnary As Object, p2 As String, count As Long
  Dim LastRow As Long, FldrName As String
 
  p2 = "C:\Users\test\Documents\"
  'p2 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
 
'------------- ActiveSheet could be a problem?
  LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
  Set rng1 = Worksheets("Main").Range("D5:D" & LastRow)
  Set rng2 = Worksheets("Candidate").Range("B2:B" & LastRow)
  Set dnary = CreateObject("Scripting.Dictionary")
  count = 0
  '--------------------------------------
Debug.Print rng2.Address
  'CREATE INDIVIDUAL FOLDERS
  If Dir(p2 & "Files\", vbDirectory) = "" Then MkDir p2 & "Files\"
  p2 = p2 & "Files\"
  For Each c2 In rng2
    If Dir(p2 & c2, vbDirectory) = "" Then MkDir p2 & c2
  Next c2


  'COPY PDF FILES IN COLUMN D TO CREATED FOLDERS
  For Each c1 In rng1
    If c1.Offset(0, 3) <= 0.5 And count <= 5 Then
      If Not dnary.Exists(c1) And Dir(c1) <> "" Then
        dnary.Add c1, 1
        For Each c2 In rng2
          FileCopy c1, p2 & Trim(c2) & "\" & Right(c1, Len(c1) - InStrRev(c1, "\"))
          'Call apiShellExecute(Application.hwnd, "print", cell.Value, vbNullString, vbNullString, 0)
          count = count + 1
        Next c2
      End If
    End If
  Next c1
'--------------------------------------




'CLEANUP
End Sub

---

Hi Ken

Thanks for your reply and help.

I am new to this so not sure why ActiveSheet would be a problem (as that's what I've picked up on my learning journey so far). Is there an alternative?

I've realised that I am using LastRow for both sheets ie. Main and Candidate. Is that what you mean when you say ActiveSheet may be a problem?

LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
Set rng1 = Worksheets("Main").Range("D5" & LastRow)
Set rng2 = Worksheets("Candidate").Range("B2:B" & LastRow)

Each candidate only needs 5 files that's why I set the counter to 5 (with the condition of a score of "<=50%"). I have had a look and can't work out the problem here.

The code runs OK but the correct files are not being copied over. Seems to copy the 1st file which is <=50% and then copy that same file into every folder. This is despite a loop running through every candidate and checking the scores for each candidate? Could you help me here please?

To control the right number or rows, explicitly set which sheet it should come from. e.g. Worksheets("Main")

You would have to explain what governs which subfolder it should go to. #1 code looked like your intent was to copy to last subfolder since it was last in the first loop. I guessed that you wanted if criterion ws matched, put in all subfolders.

Hi Ken

Sorry if I wasn't clear in my #1 post.

Each candidate would have (up to) 5 pdf files in their (newly created) folder. The pdf files for each candidate would of course be different as they have scored differently on each topic. See Column G on the Main sheet for scores. Starting from cell D5, each file would be copied and placed in each candidate folder (up to 5 files in each folder).

Thanks for your help as I've really become a bit unstuck here but I know I was nearly there so it's a bit frustrating.

If anything else is not clear please just let me know.

Thanks again

Ok, I see what you need now. IF you want 5, then we need to set count=1 before loop. We need Trim() for C2 since it is getting the subfolder name from the other sheet which has the suffix space characters.

Code:

---

Sub Save_PDF_Papers_3() 
  '(ByVal fname As String)  '--------------------------------------
  'DECLARE AND SET VARIABLES
  Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range
  Dim dnary As Object, p2 As String, count As Long
  Dim LastRow As Long, FldrName As String
 
  p2 = "C:\Users\test\Documents\"
  p2 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
 
'------------- ActiveSheet could be a problem?
  LastRow = Worksheets("Main").Cells(Rows.count, 1).End(xlUp).Row
  Set rng1 = Worksheets("Main").Range("D5:D" & LastRow)
  Set rng2 = Worksheets("Candidate").Range("B2:B" & LastRow)
  Set dnary = CreateObject("Scripting.Dictionary")
  count = 1
  '--------------------------------------


  'CREATE INDIVIDUAL FOLDERS
  If Dir(p2 & "Files\", vbDirectory) = "" Then MkDir p2 & "Files\"
  p2 = p2 & "Files\"
  For Each c2 In rng2
    If Dir(p2 & c2, vbDirectory) = "" Then MkDir p2 & c2
  Next c2


  'COPY PDF FILES IN COLUMN D TO CREATED FOLDERS
  For Each c1 In rng1
    If c1.Offset(0, 3) <= 0.5 And count <= 5 Then
      If dnary.Exists(c1) = False And Dir(c1) <> "" Then
        dnary.Add c1, 1
          FileCopy c1, p2 & Trim(c1.Parent.[c2]) & "\" & Right(c1, Len(c1) - InStrRev(c1, "\") - 1)
          ' apiShellExecute(Application.hwnd, "print", cell.Value, vbNullString, vbNullString, 0)
          count = count + 1
      End If
    End If
  Next c1
'--------------------------------------




'CLEANUP
End Sub

---

Hi Ken

Thanks but only the 1st candidate is getting the 5 files? Also Trim is trimming e.g. 'TOPICS_01.pdf' into 'OPICS_01.pdf'

I forgot to mention that I am trying to convert the Range on the Main sheet ie. A1:H29 into a pdf and also add into the candidate folder. The range pdf would be the candidates name. Could you tell me if I would just use

Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
p2\candidateName.pdf, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

and add some of it to my loop?

Once again, thanks for all your help and I appreciate it a lot.

What is the purpose for the dictionary object? Is it to not count duplicate filenames or to do maybe 5 for one candidate but the next candidate would not use any of those?

To get the Main sheet to update, an embedded loop is used to update Main sheet's cell F1.

The pdf file creation is easily done.

Hi Ken

No, it could be the case that two (or more) candidates works on say for e.g. TOPIC2 (as they both got that topic incorrect). So each candidate would have 5 files (and they may well be the same files and in a lot of cases will be the same). The goal is for each candidate to have their own 5 files (may well be the same as another candidate).

I am now trying to save ALL the files in ONE folder (as opposed to separate folders) as I've realised that will be easier for printing. However I need the main sheet range also as a pdf so that I can sort the files and know which pdfs belong to which candidate.

Hope that makes sense and thanks again for your help and patience.

I'll work it up after lunch.

1. IF the filenames don't have duplicates, I don't see a need for the dictionary.
2. Normally, I like to fso to get the base filename, check for file or folder existence. If you use this for a mac, that would not work.

Hi Ken

No I'm not using a mac.

Sorry Ken, I am new to this so I am using code that I have learnt/taken from the web/help from people.

I am trying to get all files in ONE folder now (sorted and with the MAIN sheet as a candidate_named_pdf) so if you could help me with that I would greatly appreciate it.

I don't know what ONE folder you want them in. That would simplify things.

In any case, here is the one that copies the first 5 files with <= 0.5 and their Main pdf. It also uses FSO FWIW.

Code:

---

Sub Save_PDF_Papers_4() 
  '--------------------------------------
  '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
  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")
  'Set d = CreateObject("Scripting.Dictionary")


  With fso
    'CREATE INDIVIDUAL FOLDERS
    If Not .FolderExists(p2 & "Files") Then _
      .GetFolder(p2).SubFolders.Add "Files"
    p2 = p2 & "Files\"
    Set pf = .GetFolder(p2)
    For Each c2 In rng2
      If Not .FolderExists(p2 & c2) Then pf.SubFolders.Add c2
    Next c2
 
    '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
      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 & Trim(wsM.[c2]) & "\" & .GetFileName(c1)
            'FileCopy c1, p2 & Trim(wsM.[c2]) & "\" & Right(c1, Len(c1) - InStrRev(c1, "\"))
            count = count + 1
          End If
        End If
      Next c1
      wsM.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        p2 & Trim(wsM.[c2]) & "\" & 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

---

Hi Ken

Thanks.

Sorry I meant one folder as opposed to individual folders. i.e. all files for all candidates are stored in a/one folder but are in sorted so it's clear which files belong to which candidate. That would make printing a lot easier.

Thanks for your help and sorry for the confusion.

Hi Ken

Thanks for the heads up with fso. Pretty neat way of doing it and I've noticed it works A LOT quicker than how I was doing it.

Could you tell me if I wanted to copy all the candidate files (for every candidate) into a folder called 'Paper' would I simply not include the code below (and instead create one folder called 'Paper'). Once again thanks for all your help - it really is appreciated.

For Each c2 In rng2
If Not .FolderExists(p2 & c2) Then pf.SubFolders.Add c2
Next c2

I don't know what you mean by candidate file. Is it the created pdf file from?

Code:

---

wsM.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _       
  p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & ".pdf", Quality:=xlQualityStandard, _
  IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

---

Hi Ken

Yes that's correct. However I would like ALL of the 6 files in each candidate folder (1 pdf created from the range A1:H29 and the 5 topic files) to appear in a folder called 'Paper'. So the folder called 'Paper' would probably have about 120 pdf files in it sorted, not just the 20 created pdfs (for 20 candidates) from the range A1:H29.

To put it another way. At the moment each candidate folder contains 6 pdf files. So that's 6x20=120pdfs in 20 folders.

Instead of the 6 pdf files appearing in individual candidate folders, I would like them to appear in (one) folder called 'Paper'. So that's 1x120=120pdfs.

Hope that makes sense, if not please let me know.

Since filenames in Main sheet don't appear to change for each Candidate, then the maximum number is rng1.cells.count + rng2.cells.count...

But the scores for each candidate do change which means that each candidate will have different files allocated to them???

Sorry Ken I'm a bit confused by your post. I am new to this so not sure exactly what you mean. All I am trying to do is get ALL files for each candidate in one folder instead of separate folders. That (one) folder is to be called 'Paper'. Pardon my ignorance but I thought it was a tweak of the code in my post14 ie. removing

For Each c2 In rng2
If Not .FolderExists(p2 & c2) Then pf.SubFolders.Add c2
Next c2

Apologies as looking back I think I should have made that clear in my original post.

As ever, thanks for your help and patience.

I'll work something up.

The point in #17 is that while you are only getting up to 5 for each candidate, those 5 may not be unique for all candidates. e.g. Candidate 1, has files 1,2,3,4,5. Candidate 6, has files 1,2,11,13,14. So, files 1 and 2 are duplicates. Since fso.CopyFile has an option to not overwrite, we can avoid excess overwrites.

I see.

No I do not want any overwrites as if candidate 1 has to re-do topic files 1 and 2 and candidate 2 has to also to do topic files 1 and 2, then those topic files (1 and 2) need to be allocated to both candidates. That's why I mentioned that in the (one) folder 'Paper1', there will be 120 pdf files. Yes there will be duplicates (and I need them) but the files are ordered with the 'main' candidate sheet in between each candidates topic files. I have attached screen shot so you know what I mean.

The tricky bit I think is to include the 1. / 2. / 3. / 4. / 5. etc. with each file name so that the files stay ordered and duplicates are there and not over written. Please see attached image. All candidates and all topic files would be labelled/numbered this way using the F1 cell reference?

Thanks again

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

---

Thanks Ken - that's a great help and saves me a great deal of time.

Hi Ken

Would just like to run this past you if that's OK?

If a particular candidate was to have 2 topic files that are the same topic file (which could happen in an exceptional circumstance e.g. Question 1a and Question 1b but both point to TOPIC_01.pdf sheet) in his/her top 5 <=50% would this piece of code over write the duplicate? I know we discussed not overwriting files for different candidates but for the same candidate we don't need duplicates! Sorry this is an oversight on my part. I suspect the below would throw up an error as there is no checking for duplicates before moving on and looping?




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

False means, do not overwrite if file exists already.

Quote:

---

Originally Posted by Kenneth Hobs

False means, do not overwrite if file exists already.

---

OK great ... so I could just comment 'false' out?

Thanks so much

Change False to True and it will overwrite old file if it exists.

Say you had duplicates, e.g. 1,2,3,1,1. For count of 5, there would be 3 files added . If you want 5, providing the 0.5 limit is met, then you would check if file exists first. If so, you have to decide to overwrite or skip the count, and overwrite and not increment the counter. It just depends on what you want....

OK Ken …. so I have stumbled across an issue here that I hadn't foreseen.

Every candidate must always have 5 sheets. Now for some candidates it may mean 1,2,3,4,5 but if another candidate had 1,2,3,1,1 (like you said) then the count needs to keep running to ensure that the candidate has 5 sheets (not 3 in this case). I hope that makes sense.

I'm confused as to how for some you decide to overwrite ie. True but for others it would be False. Or is it the case that I need to adjust the count?

Just state the goal. I'll decide how to code it.

e.g.
Given: Files 1,2,1,1,5,6,7,7,9 all are <= 0.5 for candidate 1.

Soln:
1. 1,2,5,6,7.
2. 1,2,5.
3. or?

I am thinking (1).

Yes Ken 1. as each candidate must have 5 topic files (+1 candidate sheet).

Thanks a lot - greatly appreciated.

Code:

---

'If c1.Offset(, 3) <= 0.5 And count <= 5 Then       
If c1.Offset(, 3) <= 0.5 And count <= 5 And _
  Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then

---

Thanks Ken that seems to have done the trick.

Hi Ken

Sorry to bother again but I am trying to give the user two options. One where all the files appear in one folder and one where all the files appear in individual folders.

I have amended the code below to do this for individual folders and it's working fine but the files appear outside the folders instead of inside each individual folder. Could you tell me where I am going wrong?

Code:

---

    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 Andcount <= 5 And _
        Not .FileExists(p2 & rn &"." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
          .CopyFile c1, p2 & "\" & rn & "." & .GetFileName(c1)
            count =count + 1
          End If
        End If
      Next c1


---

Hi Ken

I thought I had fixed it with the below by using Trim, however now I don't necessarily get 5 files for each candidate in each folder. Some only have 4 so the loop is not continuing to ensure each candidate gets 5 files. I can't see why though as it's set to 'true' with nested IFs checks. I've also added #30 code. This is for indivudal folders. Can you help?

Code:

---

    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 And _
        Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
            .CopyFile c1, p2 & Trim(wsM.[c2]) & "\" & rn & "." & .GetFileName(c1), True
            count = count + 1
          End If
        End If
      Next c1

    Next i

---

I can see 2 cases where it could be less than 5.

1. Duplicate file name exists.
2. There are fewer than 5 matched rows with <= 0.5.

1. I have a candidate that has 8 files <=50% but only the first 4 show as there's one duplicate in the first 5 files
2. As above he has 8 files <=50%

If I use the code below I get the desired result but the 5 files for each candidate appear outside each candidates folder

Code:

---

If c1.Offset(, 3) <= 0.5 Andcount <= 5 And _
        Not .FileExists(p2 & rn &"." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
          .CopyFile c1, p2 & "\" & rn & "." & .GetFileName(c1)
            count =count + 1

---

However if use the code on post 33 (below) I get the files inside the candidate folder but not necessarily 5. All I've added here is the 'Trim' function

Code:

---

For Each c1 In rng1
        If c1.Offset(, 3) <= 0.5 And count <= 5 And _
        Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
            .CopyFile c1, p2 & Trim(wsM.[c2]) & "\" & rn & "." & .GetFileName(c1), True
            count = count + 1
          End If
        End If
      Next c1

    Next i

---

I can't see why I shouldn't get 5 files on the second bit of code?

Ken I have attached images of what's happening. Hopefully this helps? The Candidate Range File appears inside the folder, the code is looping correctly (ie. keeps going 'til 5 files are copied even though I changed the filepaths so that Topic2 appears twice), however the topic files appear outside the candidate folder??? I don't know why?

The code for this is below. (It's using late binding fso)

Code:

---

  Dim fso As Object, pf As Object  'Late Binding

---

Code:

---

With fso
    If Not .FolderExists(p2 & "Files") Then _
      .GetFolder(p2).SubFolders.Add "Files"
    p2 = p2 & "Files\"
    Set pf = .GetFolder(p2)
    For Each c2 In rng2
      If Not .FolderExists(p2 & c2) Then pf.SubFolders.Add c2
    Next c2
 
    'Iterate each candidate reference to update Main sheet.
    For i = 1 To rng2.Rows.count
      wsM.[F1] = rng2(i).Offset(, -1)
      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 And _
        Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
          .CopyFile c1, p2 & "\" & rn & "." & .GetFileName(c1)
            count = count + 1
          End If
        End If
      Next c1
      wsM.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
   
  End With
'--------------------------------------

---

Hi Ken

Think I fixed it by adjusting thes lines

Code:

---

Not .FileExists(p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
          .CopyFile c1, p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & rn & "." & .GetFileName(c1)

---