Looping a macro

[Scott Browner]

I have a macro goes through a single process. I would like to add a loop to the coding to read through a list on a spreadsheet and go through the process multiple times.

Here’s what I have. “L1” and “E1” refer to cells on the spreadsheet

Sub FindFilename()
Dim FSO As Object
Dim sourcepath As String
Dim destinationPath As String
Dim fileExtn As String
Dim ActiveWorksheet As String
Dim TempFileName As String
Dim FileName As String
Dim FileNum As Long

FileNum = Range("L1").Value
sourcepath = ActiveWorkbook.Sheets(1).Range("E1").CurrentRegion.Value
destinationPath = "C:\Users\Jnet\Documents\~ 1ATEST\Ending Folder"

fileExtn = "*.pdf"

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(sourcepath) = False Then
MsgBox sourcepath & " does not exist"
Exit Sub
End If

If FSO.FolderExists(destinationPath) = False Then
MsgBox sourcepath & " does not exist"
Exit Sub
End If

FSO.CopyFile Source:=sourcepath & FileNum & fileExtn, Destination:=destinationPath

copy_files_from_subfolders

MsgBox "Your files have been copied"

End Sub

 

[davesexcel]

I added some additional lines to your code for a loop.

Sub DoIt()

    Dim c As Range, rng As Range, LstRw As Long, SH As Worksheet
    'other code

    Set SH = ActiveSheet    ' worksheet name
    With SH    '==================

        LstRw = .Cells(.Rows.Count, "L").End(xlUp).Row    '===================

        Set rng = .Range("L1:L" & LstRw)    '=========================

        For Each c In rng.Cells    '==============================

            FileNum = c.Value    '-------
            SourcePath = c.Offset(, -7).Value    '--------
            destinationPath = "C:\Users\Jnet\Documents\~ 1ATEST\Ending Folder"

            fileExtn = "*.pdf"

            Set FSO = CreateObject("scripting.filesystemobject")

            If FSO.FolderExists(SourcePath) = False Then
                MsgBox SourcePath & " does not exist"
                Exit Sub
            End If

            If FSO.FolderExists(destinationPath) = False Then
                MsgBox SourcePath & " does not exist"
                Exit Sub
            End If

            FSO.CopyFile Source:=SourcePath & FileNum & fileExtn, Destination:=destinationPath

            copy_files_from_subfolders

            MsgBox "Your files have been copied"

        Next c    '=================
    End With    '==================




End Sub

 

[Scott Browner]

Thanks for the quick response. I will try it.