Copy only certain PDF files to folder

[PATSYS]

Hi all,

I need a VBA code that copies a list of PDF files found in C:\Users\Ron\Data to C:\Users\Ron\Test. The list of PDF filenames to be copied can be found in Range A1:A100 of sheet1.

I found below code when searching the net. I think it is close to what I need with little tweaking...

Sub Copy_Certain_Files_In_Folder()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    FromPath = "C:\Users\Ron\Data" 
    ToPath = "C:\Users\Ron\Test"    

    FileExt = "*.xl*" 
    

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

Thanks

 

[nirvana_]

Here you go.

Sub CopyFilesToFolder()
    Dim FromPath As String
    Dim ToPath As String
    FromPath = "C:\Users\Ron\Data\"
    ToPath = "C:\Users\Ron\Test\"
    
    Set objFSO = CreateObject("scripting.filesystemobject")
    Set objfolder = objFSO.getfolder(FromPath)
    
    For Each MyFile In objfolder.Files
        If objFSO.GetExtensionName(MyFile) = "pdf" Then
            objFSO.CopyFile Source:=MyFile.Path, Destination:=ToPath
        End If
    Next
End Sub

 

[nirvana_]

Sorry try this instead.

Sub CopyFilesToFolder()
    Dim FromPath As String
    Dim ToPath As String
    Dim i As Integer
    i = 1
    
    FromPath = "C:\temp\"
    ToPath = "C:\ztemp\"
    
    Set objFSO = CreateObject("scripting.filesystemobject")
    
    Do While Worksheets(1).Cells(i, 1) <> ""
        Set objFile = objFSO.GetFile(FromPath & Worksheets(1).Cells(i, 1).Value)
        If objFSO.GetExtensionName(objFile) = "pdf" Then
            objFile.Copy Destination:=ToPath
        End If
        i = i + 1
    Loop
End Sub