Copy files with a certain keyword to another folder with the same keyword

[feni1388]

Hello...

I have a list of source folder and its target folder, but with the code below it only copy to the folder in the second row.
How to make it loop through the list?

The source folder is in column CA and the target folder is in column CB.

Thank you in advance.

 Dim sSrcFolder As String, sTgtFolder As String, sFilename As String
    Dim c As Range, rPatterns As Range
    
    
    sSrcFolder = ActiveSheet.Cells(2, 79)
    sTgtFolder = ActiveSheet.Cells(2, 80)
    
    Set rPatterns = ActiveSheet.Range("BU2:BU20").SpecialCells(xlConstants)
    For Each c In rPatterns
        sFilename = Dir(sSrcFolder & "*" & c.Text & "*")
        If sFilename = "" Then
            c.Interior.ColorIndex = 3
            bBad = True
        
        Else
            While sFilename <> ""
                FileCopy sSrcFolder & sFilename, sTgtFolder & sFilename
                sFilename = Dir()
            Wend
        End If
    Next c
    
    MsgBox "File copy completed"

 

[NdNoviceHlp]

Hi feni1388. It seems like this will work. Change this part of your code. HTH. Dave

Dim cnt As Integer
cnt = 1
For Each c In rPatterns
cnt = cnt + 1
sSrcFolder = ActiveSheet.Cells(cnt, 79)
sTgtFolder = ActiveSheet.Cells(cnt, 80)
sFilename = Dir(sSrcFolder & "*" & c.Text & "*")
'etc

 

[feni1388]

Hi feni1388. It seems like this will work. Change this part of your code. HTH. Dave

Dim cnt As Integer
cnt = 1
For Each c In rPatterns
cnt = cnt + 1
sSrcFolder = ActiveSheet.Cells(cnt, 79)
sTgtFolder = ActiveSheet.Cells(cnt, 80)
sFilename = Dir(sSrcFolder & "*" & c.Text & "*")
'etc

Thank you Dave.
It works perfectly.....

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave