Import số liệu từ nhiều sheet (1 người xem)

[tuan.1985]

Em có code import số liệu từ nhiều file vào file tổng hợp như bên dưới
Vấn đề e gặp phải là phải khai báo tất cả các cột ở các file cần phải import vào file tổng, vì file em rất nhiều trường nên việc khai báo này mất rất nhiều time, nên post lên đây nhờ các anh chị giúp em có cách nào đơn giản hơn ah

Em cám ơn

Option Explicit



Sub import_data()
    
    Dim DVKH 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 rDomain As Range, rInside As Range
    Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
    Dim startTime As Double
    Dim rep
     
    rep = MsgBox("Ban co muon lam moi du lieu khong?", vbYesNo)
    If rep = vbYes Then Sheet1.Range("A2:AH1000000").ClearContents
 
    getSpeed (True)
    Set DVKH = ActiveWorkbook.Sheets("PU")
    
    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 "PU" Then
                With sh
                    iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
                    iNumberOfRowsToPaste = iLastRowReport - 2 + 1
                    
                    Set rDomain = .Range("A2:A" & iLastRowReport)
                    Set rInside = .Range("B2:C" & iLastRowReport)
              
                    
                    With DVKH
                            iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                            iRowStartToPaste = iCurrentLastRow + 1
                        
                        .Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rDomain.Value2
                        .Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rInside.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

 

[tuan.1985]

Nhờ hoài thật là ngại, anh chị nào giúp em với ah