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

Đăng nhận xét (0)
Mới hơn Cũ hơn