title: Copy files from sub folders
body: <p><a href="https://i.stack.imgur.com/PKSzs.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/PKSzs.png" alt="enter image description here" /></a></p>
  <p><a href="https://i.stack.imgur.com/xg7gh.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/xg7gh.png" alt="enter image description here" /></a></p>
  <p>From Rows 5 to 204<br />
  Column B is just numbering the rows<br />
  In column C Have a list of pdf file names (these are pdf certs)<br />
  I run a bit of code and it filters the unique values from column C to column E and sorts A-Z<br />
  Column G has the formula <code>=IF(E5=&quot;&quot;,&quot;&quot;,LEFT(E5,2))</code> to get the file index No.<br />
  Column H has the formula <code>=IF(E5=&quot;&quot;,&quot;&quot;,VLOOKUP(G5+0,$I$5:$J$11,2,FALSE))</code> to get the file path for the folders where the certs are
  Columns I &amp; J are the Lookup table.</p>
  <p>I put together code which will loop down the list of cert numbers in column E and then offset(0,3) to column H where the folder file-path for that cert is. It then goes to that folder copies that particular file into a folder on my desktop, then carries on down the list in column E offsetting to the file-path until it reaches the end of the cert numbers in column E, any files that are missing it highlights in red.</p>
  <pre class="lang-vb prettyprint-override"><code>Sub CopyCerts() 'copying certs
      Application.ScreenUpdating = False
      Dim R As Range
      Set R = Range(&quot;E5:E204&quot;)
      Dim SourcePath As String, DestPath As String, FName As String, FileExists As String
      DestPath = &quot;C:\Users\GaryBaker\Desktop\Certs\&quot; 'folder to copy to
      
      For Each R In Range(&quot;E5&quot;, Range(&quot;E&quot; &amp; Rows.Count).End(xlUp)) 'Check file name in each used cell in column E
          R.Offset(0, 3).Activate
          SourcePath = ActiveCell.Value
          FileExists = Dir(SourcePath &amp; R.Value &amp; &quot;.pdf&quot;) 'checking if the cert exists
          FName = Dir(SourcePath &amp; R.Value &amp; &quot;.pdf&quot;) 'name of file from list in (E5:E)
          If FileExists = &quot;&quot; Then 'If the file does not exist highlight in red, else copy
              ActiveCell.Offset(0, -3).Font.Color = vbRed 'Highlight any Cert Nos. in range E that are missing
          Else
              FileCopy SourcePath &amp; FName, DestPath &amp; FName 'Copy the file
          End If
          Do While FName &lt;&gt; &quot;&quot; 'Loop while files found
              FName = Dir() 'Search the next file
          Loop
      Next
      MsgBox (&quot;files copied&quot;)
      Application.ScreenUpdating = True
  End Sub
  </code></pre>
  <p>I need to modify the code so it will search the subfolders of each main folder as well.</p>
  <p>I had several attempts to cobble together some code. I keep getting errors “For without Next”, “Block if without end if”, End if without Block if” etc.</p>
  <pre class="lang-vb prettyprint-override"><code>Sub CopyCertsSubFolders() 'copying certs
      Application.ScreenUpdating = False
      Dim R As Range
      Set R = Range(&quot;E5:E204&quot;)
      Dim SourcePath As String, DestPath As String, FName As String, FileExists As String, FSO As Object, fld As Object, FSOFile As Object, fsoFol As Object
      DestPath = &quot;C:\Users\GaryBaker\Desktop\Certs\&quot; 'folder to copy to
      
      If Right(SourcePath, 1) &lt;&gt; &quot;\&quot; Then
          SourcePath = SourcePath &amp; &quot;\&quot;
      End If
      
      Set FSO = CreateObject(&quot;Scripting.FileSystemObject&quot;)
      Set fld = FSO.GetFolder(SourcePath)
      If FSO.FolderExists(fld) Then
      End If
      'For Each fsoFol In FSO.GetFolder(SourcePath).subfolders
      'For Each FSOFile In fsoFol.Files
      
      For Each R In Range(&quot;E5&quot;, Range(&quot;E&quot; &amp; Rows.Count).End(xlUp)) 'Check file name in each used cell in column E
          R.Offset(0, 3).Activate
          SourcePath = ActiveCell.Value
          FileExists = Dir(SourcePath &amp; subfolders &amp; R.Value &amp; &quot;.pdf&quot;) 'checking if the cert exists in folders &amp; sub-folders
          FName = Dir(SourcePath &amp; subfolders &amp; R.Value &amp; &quot;.pdf&quot;) 'name of file from list in (E5:E)
      
          If FileExists = &quot;&quot; Then 'If the file does not exist highlight in red, else copy
              ActiveCell.Offset(0, -3).Font.Color = vbRed 'Highlight any Cert Nos. in range E that are missing
          Else
              FileCopy SourcePath &amp; FName, DestPath &amp; FName 'Copy the file
          End If
                  
          Do While FName &lt;&gt; &quot;&quot; 'Loop while files found
              FName = Dir() 'Search the next file
          Loop
      Next
      MsgBox (&quot;files copied&quot;)
      Application.ScreenUpdating = True
  End Sub
  </code></pre>