VBA#11 ○ Copy dữ liệu từ nhiều báo cáo vào 1 báo cáo tổng không cần mở báo cáo con

Option Explicit
Sub import_data()
    
    Dim master As Worksheet, sh As Worksheet
    Dim wk As Workbook
    Dim strFolderPath As String
    Dim selectedFiles As Variant
    Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer
    Dim strFileName As String
    Dim rID As Range, rQuantity As Range, rUnitPrice As Range, rKM As Range, rMC As Range
    Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
    Dim startTime As Double
    
    
    getSpeed (True)
    Set master = ActiveWorkbook.Sheets("Data")
    
    strFolderPath = ActiveWorkbook.Path
    
    ChDrive strFolderPath
    ChDir strFolderPath
    
    On Error GoTo NoFileSelected
    selectedFiles = Application.GetOpenFilename( _
                    filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
                    
    startTime = Timer
    For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
        strFileName = selectedFiles(iFileNum)
        
        Set wk = Workbooks.Open(strFileName)
        For Each sh In wk.Sheets
            If sh.Name Like "*-REPORT" Then
                With sh
                    iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
                    iNumberOfRowsToPaste = iLastRowReport - 6 + 1
                    
                    Set rID = .Range("A6:A" & iLastRowReport)
                    Set rQuantity = .Range("C6:C" & iLastRowReport)
                    Set rUnitPrice = .Range("F6:F" & iLastRowReport)
                    Set rKM = .Range("I6:I" & iLastRowReport)
                    Set rMC = .Range("K6:K" & iLastRowReport)
                    
                    With master
                        iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                        iRowStartToPaste = iCurrentLastRow + 1
                        
                        .Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rID.Value2
                        .Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rQuantity.Value2
                        .Range("E" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rUnitPrice.Value2
                        .Range("G" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rKM.Value2
                        .Range("I" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rMC.Value2
                    End With
                    
                End With
            End If
        Next sh
        wk.Close
    Next
    
    MsgBox "Done in " & Int(Timer - startTime) & " s."
    getSpeed (False)
NoFileSelected:
    MsgBox "Chua co file nao duoc chon!"
End Sub

Function getSpeed(doIt As Boolean)
    Application.ScreenUpdating = Not (doIt)
    Application.EnableEvents = Not (doIt)
    Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function