Looping a macro

Scott Browner

New Member
Joined
Mar 28, 2017
Messages
8
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
 

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
815
I added some additional lines to your code for a loop.

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,099,699
Messages
5,470,257
Members
406,686
Latest member
BNR_ 1980

This Week's Hot Topics

Top