Macro to copy files from existing space to new folder

[CombatWombat]

Hello and thank you in advance!

I want to begin by saying I am in no way an expert and I appreciate some of the incredible answers that are on this site.

I have a workbook with multiple sheets that I use to help identify useful files from old jobs that can be used in new ones.

I have set up the workbook to list all files in folders and subfolders in one sheet, which I then sort manually, and copy those I identify as important onto a second sheet.

What I am looking for is a Macro that will take a list of file paths A2:A100 on a different sheet "sheet 2" and copy those listed files into a new folder that I list in A1 "sheet2" which the macro could hopefully create.

 

[Georgiboy]

Welcome to the forum,

Perhaps the below will help:

Sub test()
    Dim sPath As String, dPath As String
    Dim tVar As Variant, fName As String
    Dim rCell As Range

    dPath = Sheet2.Range("A1").Value ' path must end with a \
    
    If Dir(dPath, vbDirectory) = "" Then
        MkDir dPath
    End If
    
    For Each rCell In Sheet2.Range("A2:A" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row)
        sPath = rCell.Value
        tVar = Split(sPath, "\")
        fName = tVar(UBound(tVar))
        Name sPath As dPath & fName
    Next rCell
End Sub

 

[CombatWombat]

Welcome to the forum,

Perhaps the below will help:

Sub test()
    Dim sPath As String, dPath As String
    Dim tVar As Variant, fName As String
    Dim rCell As Range

    dPath = Sheet2.Range("A1").Value ' path must end with a \
   
    If Dir(dPath, vbDirectory) = "" Then
        MkDir dPath
    End If
   
    For Each rCell In Sheet2.Range("A2:A" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row)
        sPath = rCell.Value
        tVar = Split(sPath, "\")
        fName = tVar(UBound(tVar))
        Name sPath As dPath & fName
    Next rCell
End Sub

Thank you for the super quick reply.

Unfortunately I am getting a "error 9 subscript out of range" for the fname line. I won't even pretend to know what that means but any further help would be amazing.

 

[Georgiboy]

Are you able to use the XL2BB add in to display what the data looks like in your sheet2?
An image would be better than nothing.

XL2BB - Excel Range to BBCode

 

[CombatWombat]

Copy of Disclosure Schedule 5.0 - Push Button.xlsm
	A
1	C:\Users\hu13b\Downloads\Keepers\
2	C:\Users\hu13b\OneDrive\Photos\DSC_0577.jpg
3
4
5
6	C:\Users\hu13b\OneDrive\Photos\IMG_8835.jpg
7	C:\Users\hu13b\OneDrive\Photos\IMG_8850.jpg
8	C:\Users\hu13b\OneDrive\Photos\IMG_8870.jpg
9
10
11
12	C:\Users\hu13b\OneDrive\Photos\IMG_8923.jpg
13	C:\Users\hu13b\OneDrive\Photos\IMG_8929.jpg
14
15	C:\Users\hu13b\OneDrive\Photos\IMG_8999.jpg
Sheet2

Cell Formulas
Range	Formula
A1	A1	=CONCATENATE($I$2,$I$9)
A2:A15	A2	=IF('Raw Data'!I2="Unused Material - To be Disclosed",'Raw Data'!A2,"")

 

[Georgiboy]

I see, the range is not contiguous, try it with the below:

Sub test()
    Dim sPath As String, dPath As String
    Dim tVar As Variant, fName As String
    Dim rCell As Range

    dPath = Sheet2.Range("A1").Value ' path must end with a \
    
    If Dir(dPath, vbDirectory) = "" Then
        MkDir dPath
    End If
    
    For Each rCell In Sheet2.Range("A2:A" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row)
        If rCell.Value <> "" Then
            sPath = rCell.Value
            tVar = Split(sPath, "\")
            fName = tVar(UBound(tVar))
            Name sPath As dPath & fName
        End If
    Next rCell
End Sub

 

[CombatWombat]

So the error code is gone now but the code doesn't appear to do anything (I press run F5 and nothing happens)

Thank you again.