Copy sheet contents faster in Excel I have code that opens a workbook and copies the sheet to the workbook running the code.  I know activating is generally bad for speed but I can't figure out how to speed this up anymore.  The data area is usually "A1:Q45000" but is different all the time.

Sub AutofillOperations()

    Dim answer As Integer, fd As FileDialog, wb1 As Workbook, wb2 As Workbook, FileName As Variant, file As Variant, location As String, filedate As Date, FileMissing As Boolean, filetime As Variant

    Set wb2 = ThisWorkbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    location = Range("K7").Value
    file = UCase(Dir(location))

    FileMissing = True

    While (file &lt;&gt; "")

        If InStr(file, UCase("Operation")) &gt; 0 Then
            filedate = DateValue(FileDateTime(location &amp; file))
            If filedate = Date Then
                FileName = location &amp; file
                Set wb1 = Workbooks.Open(FileName)
                wb1.Activate
                Cells.Copy
                wb2.Activate
                Sheet7.Activate
                Cells.Select
                ActiveSheet.Paste
                wb1.Close
                Application.CutCopyMode = False
                FileMissing = False
                GoTo EndWhile
            End If
        End If
            file = UCase(Dir)
            FileMissing = True
    Wend

EndWhile:

    If FileMissing Then
        MsgBox "File could not be found, please use dialog to verify" &amp; vbNewLine &amp; "modified date and select file.", vbInformation, "File not found"
        Set fd = Application.FileDialog(msoFileDialogFilePicker)

        fd.InitialView = msoFileDialogViewList
        fd.Filters.Clear
        fd.Filters.Add "Excel", "*.xls*"
        fd.Filters.Add "Excel", "*.csv"
        fd.FilterIndex = 1
        fd.AllowMultiSelect = False
        fd.InitialFileName = location
        fd.Title = "Select All file or Cancel to use pasted data"

        answer = fd.Show

        If answer = -1 Then
            FileName = fd.SelectedItems(1)
            Set wb1 = Workbooks.Open(FileName)
            wb1.Activate
            Cells.Copy
            wb2.Activate
            Sheet7.Activate
            Cells.Select
            ActiveSheet.Paste
            wb1.Close
            Application.CutCopyMode = False
        End If
    End If

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

    Sheet1.Activate
    Sheet2.Activate

    filetime = TimeValue(FileDateTime(location &amp; file))
    Range("D11").Value = filedate
    Range("D12").Value = filetime


End Sub
There are few places you can make this code faster and more efficient. 

Most notably, this block (repeated twice):

FileName = location &amp; file
Set wb1 = Workbooks.Open(FileName)
Cells.Copy
wb2.Activate
Sheet7.Activate
Cells.Select
ActiveSheet.Paste
wb1.Close


can be adjusted to this: 

Set wb1 = Workbooks.Open(FileName)
Set ws1 = wb1.Worksheets(1) 'make sure to Dim ws1 as Worksheet

With ws1
    'this section will grab the last row and column of actual data on the sheet, instead of copying **every** cell
    'also assumes headers in column A with no data going past left most column in row 1
    Dim lRow as Long, lCol as Long
    lRow = .Range("A" &amp; .Rows.Count).End(xlup).Row
    lCol = .Cells(1,.Columns.Count).End(xlToLeft).Column

    .Range(.Range("A1"),.Cells(lRow,lCol)).Copy wb2.Worksheets("Sheet7").Range("A1") 'change name as needed

    .Close True
End With


I'll try to do a more full review later, but have to leave now.