Chào các anh, chị,
Em có đoạn code gộp dữ liệu từ nhiều file xls có cấu trúc giống nhau, code này chạy ngon lành.
Tuy nhiên, giờ em muốn thêm 1 tí này: khi mở mỗi file xls lên thì tự động chèn giá trị (tên file đó) vào cột sau cùng của sheet, sau đó mới chép dữ liệu đó vào file chính.
Tuy nhiên, khi chạy thì nó chỉ mở 1 file đầu tiên và insert tên file vào cột mong muốn rồi đứng im luôn, không tuần tự làm với các file còn lại. Em không trace ra lỗi ở chỗ nào, mong anh chị chỉ giúp.
Đoạn code như sau:
Em có đoạn code gộp dữ liệu từ nhiều file xls có cấu trúc giống nhau, code này chạy ngon lành.
Tuy nhiên, giờ em muốn thêm 1 tí này: khi mở mỗi file xls lên thì tự động chèn giá trị (tên file đó) vào cột sau cùng của sheet, sau đó mới chép dữ liệu đó vào file chính.
Tuy nhiên, khi chạy thì nó chỉ mở 1 file đầu tiên và insert tên file vào cột mong muốn rồi đứng im luôn, không tuần tự làm với các file còn lại. Em không trace ra lỗi ở chỗ nào, mong anh chị chỉ giúp.
Đoạn code như sau:
Mã:
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 rSTT As Range, rSBD As Range, rTTNV As Range, rMaNganh As Range, rTTTT As Range, rTruong As Range
Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
Dim startTime As Double
Dim rMaNganh_Truong As Range
Dim FileName As String
getSpeed (True)
Set Master = ActiveWorkbook.Sheets("Data")
''Xoa noi dung trong sheet hien tai
With Sheets("Data")
.Range("A2").Resize(20000, 7).ClearContents
End With
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 "XT_DK" Then
With sh
iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
iNumberOfRowsToPaste = iLastRowReport - 3 + 1
'Tu dong dien ma truong theo ten file
FileName = wk.Name
.Range("F3").Select
.Range("F3").Value = FileName
Selection.AutoFill Destination:=Range("F3:F" & iLastRowReport)
.Range("G3").FormulaR1C1 = "=RC[-1]&""_""&RC[-3]"
Selection.AutoFill Destination:=Range("G3:G" & iLastRowReport)
Set rSTT = .Range("A3:A" & iLastRowReport)
Set rSBD = .Range("B3:B" & iLastRowReport)
Set rTTNV = .Range("C3:C" & iLastRowReport)
Set rMaNganh = .Range("D3:D" & iLastRowReport)
Set rTTTT = .Range("E3:E" & iLastRowReport)
Set rTruong = .Range("F3:F" & iLastRowReport)
Set rMaNganh_Truong = .Range("G3:G" & iLastRowReport)
With Data
iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
iRowStartToPaste = iCurrentLastRow + 1
.Range("B" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1).NumberFormat = "@"
.Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rSTT.Value2
.Range("B" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rSBD.Value2
.Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rTTNV.Value2
.Range("D" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rMaNganh.Value2
.Range("E" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rTTTT.Value2
.Range("F" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rTruong.Value2
.Range("G" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rMaNganh_Truong.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
" & iLastRowReport)
