Macro to speedy up process when copying Data

[howard]

I have the following code below which is rather slow when copying the data from source sheet

The code works, but is slow

 Sub Open_workbook()
    ChDir "C:\Sales Ledgers"
    Dim LR As Long
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .Calculation = xlCalculationManual
        .CutCopyMode = False
    End With
    
    With Sheets("Imported Data")
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:AD" & LR).ClearContents
    End With
    
    Dim fDialog As FileDialog
    Dim varFile As Variant
    Dim nb As Workbook, tw As Workbook, ts As Worksheet
    
    Set tw = ThisWorkbook
    Set ts = tw.ActiveSheet
    
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = "Select Excel Files"
        .Filters.Clear
        .Filters.Add "Excel files", "*.xlsm"
        .InitialFileName = "C:\Sales Ledgers\BR1*.xlsm"
        
        If .Show = -1 Then ' User clicked OK
            For Each varFile In .SelectedItems
                Set nb = Workbooks.Open(Filename:=varFile, Local:=True)
                With nb.Sheets(3)
                    .Range("A1:AD2000").Copy
                    tw.Sheets("Imported Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    tw.Sheets("Imported Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormats
                End With
                nb.Close False
            Next varFile
        End If
    End With
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .CutCopyMode = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
    End With
    

End Sub

It would be appreciated if someone could amend code to optimise process

 

[Logit]

Untested here.

Try replacing these two lines ;

tw.Sheets("Imported Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    tw.Sheets("Imported Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormats

With this single line :

tw.Sheets("Imported Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAllUsingSourceTheme

 

[howard]

Many thanks for the help. Works much better

 

[Logit]

Great