move files from folders and subfolder

Mussa

If you have files in a folder and first-level subfolders, this should work... 

In the modified code below, I've declared the variables ct and destpath at a module level so they can be used when each folder or subfolder name is passed to a (new) function which performs  your actions:

Dim ct As Long, destPath As String

Sub r()

Dim Fso As Object, objFolder As Object, objSubFolder As Object ', ct As Long
Dim sourcePath', destpath as String
Dim FileInFolder As Object

sourcePath = "C:\Users\PC WORLD\Desktop\zz\"  'Change path and folder name to suit
destPath = "C:\Users\PC WORLD\Desktop\mmm\"  'Change path and folder name to suit
Set Fso = CreateObject("Scripting.FileSystemObject")


LoopFolder (sourcePath)

Set objFolder = Fso.GetFolder(sourcePath)

For Each objSubFolder In objFolder.subfolders
    LoopFolder (objSubFolder)
Next objSubFolder

If ct > 0 Then
    MsgBox ct & " pdf files have been moved"
Else
    MsgBox "No pdf files found in the source folder"
End If
End Sub


Private Function LoopFolder(AFolder)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set ThisFolder = Fso.GetFolder(AFolder)

    For Each FileInFolder In ThisFolder.Files
    If FileInFolder.Name Like "*.pdf*" Or FileInFolder.Name Like "*PDF*" Then
        ct = ct + 1
        FileInFolder.Move destPath
    End If
Next FileInFolder

End Function

Hope this works for you.