Nhập và xuất dữ liệu bằng VBA trong excel

Để 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.

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

Leave a Comment

sơn epoxy / sơn sàn epoxy / cửa lưới chống muỗi / vách ngăn lướii chống muỗi / cửa lùa chống muỗi / vệ sinh công nghiệp / đánh bóng sàn bê tông / vệ sinh nhà máy / dịch vụ giặt thảmm / vệ sinh nhà hàng / vệ sinh tòa nhà / dịch vụ vệ sinh kính / vệ sinh khách sạn / vệ sinh chung cư / dịch vụ cắt cỏ / đánh bóng kính / diệt côn trùng / diệt mối / diệt kiến / diệt muỗi / diệt ruồi / diệt gián / diệt chuột / dọn bể nước ngầm / phụ kiện mái che / cơ khí chế tạo / mái che di động / rèm nhựa / vách nhựa ngăn phòng lạnh / rèm nhựa phòng lạnh / dù che nắng / mái kéo di động / nhà bạt di động / mái xếp di động / mái hiên di động / thay bạt mái hiên di động / bạt che nắng / phụ kiện mái che di động / mái che sân thượng / mái che quán cafe / mái che di động miền bắc / mái che di động miền nam / bạt che di động hcm /