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
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
Mã:
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
