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!

 

[AnnieLox]

I arranged it in the fashion you said, column A and then a small list of names, but its not moving the files. I think it is because its wanting to match the name exactly. So my sample excel will say "First Choice" but the file says "First Choice Disputes" and line two says "Annie" and the files in the folder say " 18 Annie" , "19 Annie" , "20 Annie"

 

[Fluff]

Should be working. This line

If d Like "*" & .Range("A" & Rw).Value & "*"

is saying if the file name contains the value in col A.
That said if your files are .xlsx, or xlsm files changed this line, as per the bit in red

ext = Array("*.xls[COLOR=#ff0000]*[/COLOR]", "*.pdf")

 

[AnnieLox]

I figured it out!! it didn't like this line

destPath = "H:\Annie\Delete2\" & .Range("A" & Rw).Value & "\"

but when I removed & .Range("A" & Rw).Value & "" it worked perfect!!

so this is the code for it. ( I'm reposting it because when I read other peoples post I love it when the correct macro is completely listed.)

Sub MoveFiles2()
        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\"
            ext = Array("*.xls*", "*.xlsm*", "*.xlsx*", "*.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

 

[Fluff]

Glad you sorted it out.
I thought you had wanted a separate folder for each vendor

 

[AnnieLox]

oh I do... I just wasn't thinking about that part 30 minutes go!

i saw elsewhere a code that does something like this

FromDir = Cells(Rw, 1).Value
Files = Cells(Rw, 2).Value
ToDir = Cells(Rw, 3).Value

 

[Fluff]

In that case as long as the folders exist this code should work

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

 

[AnnieLox]

It stops working when I add in the Range value to the destination path.

my excel shows...

Name	Path	Dir	Name
Linden	T:\All Vendors Invoices\LINDEN BULK\	T:\All Vendors Invoices\	LINDEN BULK

<tbody>

</tbody>

and the file destination - as copied from the properties is: H:\Annie\Delete2\Linden

and the sample file I'm attempting to move is a regular PDF.

any ideas?

 

[Fluff]

Are you trying to move the files to a folder called
T:\All Vendors Invoices\LINDEN BULK\
or to one called
H:\Annie\Delete2\Linden\

 

[Fluff]

Another thought, can you manually move a file into the folder?

 

[AnnieLox]

where I want the file eventually is T:\All Vendors Invoices\LINDEN BULK\
but in an attempt to make sure I wasn't messing up, I made 2 folders in both locations, one called LINDEN BULK, one called Linden. The folder paths are T:\All Vendors Invoices\LINDEN BULK\ and H:\Annie\Delete2\LINDEN BULK

I've tried putting in both locations in the destination path. and I made lots of dummy PDF files that say linden in both the starting folders.

Yes I can drag the file.