Để
copy dữ liệu từ một sheet trong một file này sang một sheet trong một file khác,
chúng ta thường phải mở cả 2 file lên và chọn vào sheet cần copy dữ liệu rồi
quét chọn vùng cần copy sau đó quay sang file muốn paste vào rồi chọn sheet cần
paste vào để dán dữ liệu vừa copy được vào.
Công
việc này rất tốn thời gian nhất là các bạn thường phải làm báo cáo hàng
tuần.
Ví
dụ bạn phải trích xuất một file dữ liệu nào đó ra excel và sau đó cần phải copy
dữ liệu vào file excel chính của bạn để tính tổng. thì việc này quả là đâu
đầu.
Đoạn
code dưới đây sẽ giúp bạn phần nào vất vả mà bạn đã và đang gặp phải.
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
' Mo va chon file can copy
selectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
' Neu loi thi bo qua va tiep tuc
On Error Resume Next
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
getSpeed (False)
End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function
