Copy dữ liệu từ file này sang file khác bằng VBA

Để 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
Nguồn: https://www.hochoaihocmai.com