Excel VBA macro loops through 20-28 sheets taken from filenames in cells and pastes them to the main workbook My apologies for a "repost", my original post was only partial and confusing. Here is a better snippet. This runs fairly slow (30 seconds or so) cycling through 20 workbooks. Any suggestions for improvement would be appreciated; I have left out my dimming of variables at the beginning, as well as my error handling portions, as those all work just fine.

For even MORE details, the user enters file paths into a column of up to 28 filepaths, and then the adjacent column derives the file name from the path. This macro, once initiated via a command button, begins cycling through all those filepaths, opening the document, copying and pasting it to the main workbook, until it reaches an empty cell in the column, to which then it stops.

There are also a few other small parts in there, like updating the last modified date when the button is clicked, as well as taking information from the first opened sheet to let the user know (on the main page) what kind of information is being pulled or has been pulled. Additionally, I often include frequent status bar updates for my impatient users who don't like staring at a spinning cursor without being told what's going on.

Private Sub CommandButton19_Click()

Application.DisplayStatusBar = True
Application.ScreenUpdating = False 'run faster
Application.DisplayAlerts = False 'prevents clipboard prompt
Application.Cursor = xlWait

On Error GoTo HandleIt

    Dim RangeDifferentiator As Integer
    Dim i As Long
    Dim SheettoCopyLoop
    Dim FileToCopyLoop
    Dim FileNameLoop

For i = 1 To 28 'start loop (28 because the last row being used is 34. If we need more rows this needs to change)

    RangeDifferentiator = i + 5
    Sheets("Admin").Select
    SheettoCopyLoop = Range("D" &amp; RangeDifferentiator)
    FileToCopyLoop = Range("E" &amp; RangeDifferentiator)
    FileNameLoop = Range("F" &amp; RangeDifferentiator)

If FileToCopyLoop &lt;&gt; "" Then

    Application.StatusBar = "Pulling data for " &amp; SheettoCopyLoop &amp; "..." 'let's us know which one it's pulling
    Sheets(SheettoCopyLoop).Cells.ClearContents
    Workbooks.Open Filename:= _
        FileToCopyLoop
    'Needs optimizing
    Sheets("Summary").Cells.Copy

    'Establishes if this is a MTD or YTD file and up to what month it's pulling
    If i = 1 Then
        Workbooks("YTD File.xlsm").Sheets("SM Summaries").Range("C2").Value = ActiveWorkbook.Sheets("Summary").Range("C6").Value
        Workbooks("YTD File.xlsm").Sheets("SM Summaries").Range("C4").Value = ActiveWorkbook.Sheets("Summary").Range("C5").Value
    End If

    'Needs optimizing
    Windows("YTD File.xlsm").Activate
    Sheets(SheettoCopyLoop).Select
    Sheets(SheettoCopyLoop).Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Range("A1").Select
    Windows(FileNameLoop).Close
    Sheets("Admin").Select
    Range("A1").Select

Else
Application.StatusBar = "READY"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Cursor = xlDefault
'Show last modified date on admin page for the user
Workbooks("YTD File.xlsm").Sheets("Admin").Range("F1").Value = "Last modified: " &amp; Date
MsgBox "Data pull complete!", vbInformation, "Success!"
Exit Sub
End If

Next i
Exit Sub

'The following is all error handling to help show what went wrong and where
HandleIt:
If SheettoCopyLoop &lt;&gt; "" Then
errorhandler = MsgBox("Oops! An error has occured on page " &amp; SheettoCopyLoop &amp; ". Check to make sure file exists/file path is correct.", vbExclamation, "Error!")
Application.StatusBar = "Error occured on page " &amp; SheettoCopyLoop 'Show where error occured on status bar if applicable
Else
errorhandler = MsgBox("Oops! An unknown error has occured.", vbCritical, "Error!")
Application.StatusBar = "Unknown error"
End If
Worksheets("Admin").Activate
Range("H7").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Exit Sub
End Sub
I'm not sure why it takes 30 seconds to process the 20 files, because with my almost empty test files, your code only takes 2.202 seconds (21 files). I'm guessing those files are quite large, contain a lot of objects, charts, data (?)

If they have a lot of rows I'd suggest changing them to the xlsb format, which will compress them quite a bit (size could go down to 40%), and they will be a lot faster to open and close


  XLSB Format
  
  XLSB is the Excel binary format. It is structured as a compressed
  folder that contains a large number of binary files. It is much more
  compact than the XLS format, but the amount of compression very much
  depends on the contents of the workbook. For example, ten workbooks
  show a size reduction factor ranging from two to eight with an average
  reduction factor of four...


Another consideration is that interacting with files over the network is considerably slower than the local drive



Related to the code, there are a few basic issues:


ALWAYS Use "Option Explicit"
You almost never need the Select and Activate methods


Impact performance, and all you need to do can be accomplished without them






To properly replace the select statements you need to refer to all objects explicitly:



  Example - instead of

Windows("YTD File.xlsm").Activate
Sheets(SheettoCopyLoop).Select
Sheets(SheettoCopyLoop).Range("A1").Select
ActiveSheet.Paste

  
  use:

Windows("YTD File.xlsm").Sheets(SheettoCopyLoop).Range("A1").Paste






Indent your code to make it easier to read, and distinguish hierarchies of logic and nesting
It's better to prevent all errors than to rely on the "On Error GoTo" statements


There are few errors that cannot be avoided
The GoTo statement breaks the flow and structure of the code

Turn off Application.Calculation (to manual) if possible
Don't force the user to dismiss dialog boxes after every iteration


They only need to be aware if their task cannot be completed





I made some changes, such as copying the entire sheets to the main Workbook, instead of copying only the data, so here is how I would change your code:



Option Explicit

Private Sub CommandButton19_Click2()
    Dim wb As Workbook, ws As Worksheet, newWB As Workbook
    Dim wsSMS As Worksheet, wsS As Worksheet, wsNew As Worksheet
    Dim fileInfo As Variant, sheetToCopy As String, r As Long
    Dim fileToCopy As String, fileName As String, t As Double

    t = Timer

    OptimizeXl True, xlWait

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Admin")
    Set wsSMS = wb.Worksheets("SM Summaries")

    fileInfo = ws.Range("D6:F34").Value2

    For r = 1 To UBound(fileInfo)               'max xl sheet name length = 31 chars
        sheetToCopy = Left(fileInfo(r, 1), 31)  'column 1 of Range("D6:F34") (Col D)
        fileToCopy = fileInfo(r, 2)             'column 2 of Range("D6:F34") (Col E)
        fileName = fileInfo(r, 3)               'column 3 of Range("D6:F34") (Col F)

        'Continue only if all necessary file details are not empty
        If Len(fileToCopy) &gt; 0 And Len(sheetToCopy) &gt; 0 And Len(fileName) &gt; 0 Then
            If Len(Dir(fileToCopy)) &gt; 0 Then    'continue only if file exists
                Application.StatusBar = "Pulling data for " &amp; fileName &amp; "..."

                Set newWB = Workbooks.Open(fileToCopy, False, True) 'NoLinks, ReadOnly

                If WsExists(newWB, "Summary") Then
                    'Delete existing sheet named "sheetToCopy"
                    If WsExists(wb, sheetToCopy) Then wb.Worksheets(sheetToCopy).Delete
                    Set wsS = newWB.Worksheets("Summary")
                    If r = 1 Then
                        wsSMS.Range("C2").Value = wsS.Range("C6").Value
                        wsSMS.Range("C4").Value = wsS.Range("C5").Value
                    End If
                    'Copy new sheet into this workbook, and rename it to "sheetToCopy"
                    wsS.Copy After:=wb.Worksheets(wb.Worksheets.Count)
                    Set wsNew = wb.Worksheets(wb.Worksheets.Count)
                    wsNew.Name = sheetToCopy
                Else
                    Debug.Print "Invalid sheet name for file on row " &amp; r
                End If
                newWB.Close False
            Else
                Debug.Print "Invalid fileToCopy on row " &amp; r &amp; " (" &amp; fileToCopy &amp; ")"
            End If
            ws.Range("F1").Value2 = "Last modified: " &amp; Date
        Else
            Debug.Print "Empty fileToCopy, sheetToCopy, or fileName on row " &amp; r
        End If
    Next
    ws.Activate
    OptimizeXl False
    Application.StatusBar = "READY"
    Debug.Print "V2 Time: " &amp; Format(Timer - t, "0.000") &amp; " sec"
    MsgBox "Data pull complete!", vbInformation, "Success!"
End Sub




Private Sub OptimizeXl(ByVal stat As Boolean, Optional ByVal curs As Long = xlDefault)
    Application.Calculation = IIf(stat, xlCalculationManual, xlCalculationAutomatic)
    Application.ScreenUpdating = Not stat
    Application.DisplayAlerts = Not stat
    Application.Cursor = curs
End Sub

Private Function WsExists(ByRef wb As Workbook, ByVal wsName As String) As Boolean
    Dim ws As Worksheet
    If Not wb Is Nothing Then
        If Len(wsName) &gt; 0 Then
            For Each ws In wb.Worksheets
                If ws.Name = wsName Then
                    WsExists = True
                    Exit Function
                End If
            Next
        End If
    End If
End Function




Test results:


V1 Time: 2.202 sec (your code)
V2 Time: 1.012 sec