Excel VBA macro loops through 20-28 sheets taken from filenames in cells and pastes them to the main workbook
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