Để 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.
Import (nhập) dữ liệu từ một file khác vào.
Export (xuất) dữ liệu từ một file khá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.
Import (nhập) dữ liệu từ một file khác vào.
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
Export (xuất) dữ liệu từ một file khác vào.
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 paste 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 master 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 sh 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