FileCopy based on cell reference and loop

OldsLKJ

New Member
Joined
Jan 25, 2023
Messages
3
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I'm a novice at all of this and have no formal education in coding. I use google and do my best to cobble things together, but I've hit a wall which I will describe below. Thanks in advance for any help you can provide.

I work as an academic advisor in higher education, and for each new student, I must create a folder based on their information (Last_First_emailID) and then copy the curriculum sheet for that student's major into their folder and name it with the student's info (cs_emailID_major). I have cobbled together the code to make the folders, but I'm having trouble figuring out how to copy the curriculum sheet and rename it in the new destination. It needs to go row by row because, while all the original curriculum sheets are in a single folder, the one to copy is based on each student's major, and the folder to copy them to and how to rename them is also dependent on the student info in the spreadsheet. The example below is missing a couple of columns irrelevant to this issue.

ABDGHKL
LastFirstGIDCurriculum SheetFolder NameSource FilePath with FilenameDest FilePath with Filename
DoeJanejad0001CSCIDoe_Jane_jad0001C:\PATH\cs_GID_CSCI.xlsxC:\PATH\Doe_Jane_jad0001\cs_jad0001_CSCI.xlsx
SmithJohnjbs0001MECHSmith_John_jbs0001C:\PATH\cs_GID_MECH.xlsxC:\PATH\Smith_John_jbs0001\cs_jbs0001_MECH.xlsx

Here's the code I use to create the folders after selecting the range in column H:
Folder Creation
Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub


I had a module for the file copy, but it was removing the file from the initial destination and renaming it in the new destination - so moving and renaming rather than copying. If two students had the same major, I was running into issues and having to do more work. What I really want is for the code to copy K2 to L2 and then loop to K3 and L3 and so on. Each time I run it, I have a different number of students, but I can edit the code to specify the range each time I run it if necessary. I just can't figure out how to incorporate the cell references and the loop after lots of googling.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Here is the code I've been using to move the files and rename them:

VBA Code:
Sub Renamefiles()

    Dim I As Long
    
'Column K has Source Path and Filename
'Column L has Destination Path and Filename

    For I = 2 To Range("K" & Rows.Count).End(xlUp).Row
        Name Range("K" & I).Value As Range("L" & I).Value
    Next I

End Sub
 
Upvote 0
VBA Code:
Sub Check()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Dim lr, i As Long
        
        lr = Range("K" & Rows.Count).End(xlUp).Row
        
        For i = 2 To lr
                FSO.CopyFile Range("K" & i).Value, Range("L" & i).Value
        Next i

End Sub
 
Upvote 0
Solution
VBA Code:
Sub Check()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Dim lr, i As Long
       
        lr = Range("K" & Rows.Count).End(xlUp).Row
       
        For i = 2 To lr
                FSO.CopyFile Range("K" & i).Value, Range("L" & i).Value
        Next i

End Sub
Thank you so much, even though words cannot express how grateful I am for your solution.
 
Upvote 0

Forum statistics

Threads
1,214,982
Messages
6,122,573
Members
449,089
Latest member
Motoracer88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top