Macro To Move Files to different Folder

[AnnieLox]

Hello! First time for me to post!! I'm a self taught Macro maker so have patience please.
I am trying to create a macro to move files from one folder to another. I've tried reading and working off other macros I found on here but cant get it to work.

I have an excel sheet with a column of Vendors.

The folder I have will say something like "Bulk 5227834" and there will be up to 70 files with different numbers. I need all of the bulk to move from that folder to the vendor folder. additionally it can either be a PDF or an excel.

I have created a dummy folder to try and do this.

this is the code I have. (It doesn't work) but even if it did, I need the macro to look through the list of vendors, theres too many to write a code line for each.

Dim d As String, ext, x

    Dim FSO As Object
    Dim FromDir As String
    Dim ToDir As String
    Dim FExtension  As String
    Dim FNames As String
    Dim Files As String
    Dim LR As Long
  
    LR = Sheets("Macro").Range("A" & Rows.Count).End(xlUp).Row
    For RW = 2 To LR

    
    
Dim srcPath As String, destPath As String, srcFile As String
srcPath = "H:\Annie\delete\"
destPath = "H:\Annie\delete2\"
ext = Array("19", "April")
For Each x In ext
    d = Dir(srcPath & x)
        Do While d <> ""
            srcFile = srcPath & d
            FSO.MoveFile , destPath & d
            d = Dir
        Loop
Next
End Sub

any help will be greatly appreciated!

 

[Fluff]

Try this

Sub MoveFiles()

    Dim d As String, ext As Variant, x As Variant
    Dim srcPath As String, destPath As String, srcFile As String

    Dim FSO As Object
    Dim LR As Long
    Dim Rw As Long
  
    Set FSO = CreateObject("scripting.filesystemobject")
    
    With Sheets("Macro")
        For Rw = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            srcPath = .Range("B" & Rw).Value
            destPath = .Range("C" & Rw).Value
            ext = Array("*.xls*", "*.pdf")
            For Each x In ext
                d = Dir(srcPath & x)
                    Do While d <> ""
                        If d Like "*" & .Range("A" & Rw).Value & "*" _
                            And Not d Like "*CK*" Then
                                srcFile = srcPath & d
                                FSO.MoveFile srcPath & d, destPath & d
                        End If
                        d = Dir
                    Loop
            Next x
        Next Rw
    End With
    
End Sub

And in the sheet called Macro have

Excel 2013 32 bit
	A	B	C
1	Name	From Path	To Path
2	Linden	T:\All Vendors Invoices\LINDEN BULK\	H:\Annie\Delete2\LINDEN BULK\
3	Calumet	T:\All Vendors Invoices\Calumet Bulk\	H:\Annie\Delete2\Calumet Bulk\
Macro

 

[AnnieLox]

IT WORKED!!!!!

I feel like I could scream I'm so happy! thank you so much for not giving up!!

 

[Fluff]

Glad to help & thanks for the feedback

 

[AnnieLox]

I'm so sorry, I have one last question. Can we make it not case sensitive?

I was trying to do it on my own but I cant make the option compare text work.

 

[Fluff]

I would advise putting this in a module of its own, otherwise any other macros might not work as expected.
so the new module would look lke this

Option Explicit
Option Compare Text

Sub MoveFiles()

    Dim d As String, ext As Variant, x As Variant
    Dim srcPath As String, destPath As String, srcFile As String

    Dim FSO As Object
    Dim LR As Long
    Dim Rw As Long
  
    Set FSO = CreateObject("scripting.filesystemobject")
    
    With Sheets("Macro")
        For Rw = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            srcPath = .Range("B" & Rw).Value
            destPath = .Range("C" & Rw).Value
            ext = Array("*.xls*", "*.pdf")
            For Each x In ext
                d = Dir(srcPath & x)
                    Do While d <> ""
                        If d Like "*" & .Range("A" & Rw).Value & "*" _
                            And Not d Like "*CK*" Then
                                srcFile = srcPath & d
                                FSO.MoveFile srcPath & d, destPath & d
                        End If
                        d = Dir
                    Loop
            Next x
        Next Rw
    End With
    
End Sub

 

[AnnieLox]

worked like a charm!!! you are a life saver!

 

[Fluff]

Glad to help & have a good weekend

 

[Max77]

I am very new to this excel VBA and trying my best to learn the VB script.
At present i am using the same code that you have provided (link: Macro To Move Files to different Folder)

In my case there is no exception like file name with CK should not be moved so i have changed one line the code just removed CK
From: And Not d Like "*CK*" Then To: And Not d Like "" Then -> The code is working just want to confirm will this have any impact?

My case is also same column A has all the file name Column B has Source path and Column C has destination path but i need to highlight the file name in the list incase if the file is missing from the source folder. The whole row can be highlighted or the file name in the list can be highlighted. Request to please help☺.

 

[Fluff]

Hi & welcome to MrExcel
If you don't want the exception then use

                        If d Like "*" & .Range("A" & Rw).Value & "*" Then
                                srcFile = srcPath & d

as for the other part of your question, you will need to start a new thread

 

[Max77]

thank you for the response??