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]

Hi & welcome to the board
Try this for your test folder

Sub MoveFiles()

    Dim d As String, ext As String, 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")
    
'    LR = Sheets("Macro").Range("A" & Rows.Count).End(xlUp).Row
'    For Rw = 2 To LR
        srcPath = "H:\Annie\delete\"
        destPath = "H:\Annie\delete2\"
        ext = Array("*.xls", "*.pdf")
        For Each x In ext
            d = Dir(srcPath & x)
                Do While d <> ""
                    srcFile = srcPath & d
                    FSO.MoveFile srcPath & d, destPath & d
                    d = Dir
                Loop
        Next x
'    Next Rw
End Sub

If it works we can then look at looping through the folders

 

[AnnieLox]

I'm getting the Compile Error:
For Each may only iterate over a collection object or array

and it goes to this line of the code:

For Each x In ext

 

[Fluff]

Apologies, changed the Dim setting after I tested.

Dim d As String, ext As [COLOR=#ff0000]Variant[/COLOR], x As Variant

Make the change in red

 

[AnnieLox]

Yes!! it worked!

 

[Fluff]

Yes!! it worked!

Ok
Where is the list of folders, you want to move files from, & where is the list of folders you want to move the files to?
Also do those lists show the complete folder path?
If not what is the base path?

 

[AnnieLox]

Thank you so much for all of your help!!

There's a large list (337), and it will need edits when we get new vendors.
my excel sheet is saved as
H:\Annie\Move Vendor Files

The folder where the files are is:T:\All Vendors Invoices\ALL VENDORS

and the folder where the files get moved to every day is:
T:\All Vendors Invoices\ (******insert vendor name here*******)


and the excel sheet is laid out as such


Path Dir Name
T:\All Vendors Invoices\23 FREIGHT 5B FREIGHT T:\All Vendors Invoices\ 23 FREIGHT 5B FREIGHT

 

[Fluff]

How can we tell which files belong to which vendors?

 

[AnnieLox]

the files are saved with the vendor in the name of the file. Additionally, some files they put a CK afterwards and those should not be moved- if that's possible.

Here's a sample of some from today:

2572441 Linden
2572453 Linden
2572352 Calumet
2572485 Bulk Express
2572509 First Choice
2572504 First Choice
2572679 Calumet
2572784 Boasso
2572991 cma CK

 

[Fluff]

Give this a go

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 = "H:\Annie\delete\"
            destPath = "H:\Annie\delete2\" & .Range("A" & 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

This assumes that all the relevant directories exist, & that you have a list of vendors in col A of sheet "Macro" like

Excel 2013 32 bit
	A
1	Vendor Names
2	Linden
3	Calumet
4	Bulk Express
5	First Choice
Macro