Excel macro to check column "A" and move images to another folder and create a excel

Excel macro to check column "A" and move images to another folder and create a excel

I have a folder with 500 images

I want help with a macro that can make 5 folders and move 100 images into each folder as per the same order i have in excel column "A" and than create a excel within each folder with those exact 100 rows of content that was moved

So in the end i have 5 folders and 1 excel in each with exact rows

I need the whole row copied into the excel
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
Have you got an example workbook of how the list is formatted?
mtthompsonsAuthor Commented:
Excel is very simple Column "A" with image name as


Column B to X i have some other image related data
Is the workbook in the same folder as the 500 image files?
Roy CoxGroup Finance ManagerCommented:
We need to know where the files are in i.e file path and where to move to
Roy CoxGroup Finance ManagerCommented:
Here's some code that  can be adapted

Option Explicit

Sub Move_Files()
   Const ,sText = "Images A"
    Dim oWbk   As Workbook
    Dim sFil   As String
    Dim sPath  As String
    Dim OldFilePath As String
    Dim NewFilePath As String
    On Error Resume Next 'in case folder exists
    sPath = ThisWorkbook.Path & Application.PathSeparator    'location of files
    MkDir sPath & sText    ' creates a new folder in the active folder
    sFil = Dir(sPath & "*.xls")    'change or add formats
    Do While Right(sFil, 14) = sText & ".jpg" 'will start LOOP until all files in folder sPath have been looped through
            OldFilePath = sPath & sFil    ' original file location
            NewFilePath = sPath & sText & Application.PathSeparator & sFil    ' new file location
            Name OldFilePath As NewFilePath    ' move the file  
        sFil = Dir(sPath & "*.xls")    'change or add formats
    Exit Sub
On Error GoTo 0
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.