Tinh gọn giúp em đoạn mã để chạy nhanh hơn ạ

[MỹHạnhCB]

Nhờ các anh chị xem giúp em có thể tinh gọn đoạn mã (code) này ạ, em mày mò được vậy nhưng khi chạy xoay vòng hơi lâu ạ ( tầm 4s ). Cảm ơn các anh chị
"

Sub getinfo_Film1()
    Dim fileExplorer As FileDialog
    Dim filepath(300) As String
    Dim wb As Workbook, ws As Worksheet
    Dim lr, lr1 As Integer
    Dim fso As Object
    'Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set ex1 = ThisWorkbook.Sheets("DANHMUCLOAINHA")
    Sheets.Add.Name = "Mau1"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
    With fileExplorer
        .Title = "Select Log Film"
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "xlsx file", "*.xlsx"
        .InitialFileName = ""
        If .Show <> -1 Then Exit Sub
            For i = 1 To .SelectedItems.Count
                filepath(i) = .SelectedItems(i)
            Next i
    End With
    
    i = 1
    While filepath(i) <> ""
        Set wb = Workbooks.Open(filepath(i))
        Set ws = wb.Sheets(1)
    lr = ws.Cells(Rows.Count, 3).End(xlUp).Row
        ws.Range(Cells(2, "B"), Cells(lr, "F")).Copy ThisWorkbook.Sheets("Mau1").Cells(1, "A")
        wb.Close
    ThisWorkbook.Sheets("Mau1").Range(Cells(1, "B"), Cells(lr, "B")).Cut
    Columns("A:A").Insert Shift:=xlToRight
   Range(Cells(1, "A"), Cells(lr, "D")).Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlNo
        ex1.Cells(2, "M") = "=IF(RC[-4]<>"""",VLOOKUP(RC[-11],'Mau1'!R1C1:R88C2,2,0),VLOOKUP(RC[-11],'Mau1'!R46C1:R88C2,2,0))"
        ex1.Cells(2, "C") = "=CODE!R13C2"
        ex1.Cells(2, "D") = "=CODE!R14C2"

    ex1.Visible = True 'xlSheetHidden
    ex1.Select
    lr1 = ex1.Cells(Rows.Count, 5).End(xlUp).Row
    ex1.Range(Cells(2, "E"), Cells(lr1, "E")).Copy ex1.Cells(2, "F")
    
    ex1.Range(Cells(2, "A"), Cells(lr1, "M")).Copy
    ex1.Cells(2, "A").PasteSpecial , Paste:=xlPasteValues
    ex1.Range(Cells(2, "B"), Cells(lr1, "B")).Clear
    Sheets("Mau1").Delete
    With Application
            ex1.Copy
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\DANHMUCLOAINHA"
    End With
     i = i + 1
     ex1.Visible = xlSheetHidden
    Wend
    'Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.AskToUpdateLinks = True
    'Range("E2:F300").NumberFormat = "yyyy-mm-dd hh:mm:ss"
    MsgBox "HoanThanh"
End Sub

"

 

[Maika8008]

Mở nhiều file, rồi cắt, sao chép dữ liệu thì bảo nhanh là nhanh thế nào được?

Còn muốn tinh gọn thì ví dụ 1 trường hợp thay 2 dòng này:
ex1.Range(Cells(2, "A"), Cells(lr1, "M")).Copy
ex1.Cells(2, "A").PasteSpecial , Paste:=xlPasteValues

bằng dòng này:
ex1.Range(Cells(2, "A"), Cells(lr1, "M")).Value = ex1.Range(Cells(2, "A"), Cells(lr1, "M")).Value
(có lẽ nhanh hơn 1 chút nhưng không đáng kể)

 

[MỹHạnhCB]

Mở nhiều file, rồi cắt, sao chép dữ liệu thì bảo nhanh là nhanh thế nào được?

Còn muốn tinh gọn thì ví dụ 1 trường hợp thay 2 dòng này:
ex1.Range(Cells(2, "A"), Cells(lr1, "M")).Copy
ex1.Cells(2, "A").PasteSpecial , Paste:=xlPasteValues

bằng dòng này:
ex1.Range(Cells(2, "A"), Cells(lr1, "M")).Value = ex1.Range(Cells(2, "A"), Cells(lr1, "M")).Value
(có lẽ nhanh hơn 1 chút nhưng không đáng kể)

dạ vâng cám ơn anh nhiều