VBA#11 ○ Copy dữ liệu từ nhiều báo cáo vào 1 báo cáo tổng không cần mở báo cáo con


Đây là bài số #11 trong loạt videos Hướng dẫn VBA trong Excel và ứng dụng của VBA trong công việc


Công việc consolidate và copy dữ liệu từ nhiều nguồn báo cáo khác nhau vào một bảng tính trong excel để thực hiện công việc phân tích có thể mất khá nhiều thời gian nếu làm bằng tay. Đoạn VBA được giới thiệu trong bài này có thể định hướng cho các bạn làm công việc này với sự giúp đỡ của VBA.

Code VBA sử dụng trong bài:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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
    
    On Error GoTo NoFileSelected
    selectedFiles = Application.GetOpenFilename( _
                    filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
                    
    startTime = Timer
    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
    
    MsgBox "Done in " & Int(Timer - startTime) & " s."
    getSpeed (False)
NoFileSelected:
    MsgBox "Chua co file nao duoc chon!"
End Sub

Function getSpeed(doIt As Boolean)
    Application.ScreenUpdating = Not (doIt)
    Application.EnableEvents = Not (doIt)
    Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function

Download tài liệu kèm theo video tại đây

  1. Download excel file
  2. Download code file

Các kiến thức liên quan:

Series video về VBA trong excel


➤ Subscribe: http://youtube.com/user/ductnguy?subscribe_confirmation=1

➤ Facebook group: https://www.facebook.com/groups/569100319856001/

➤ Facebook page: https://www.facebook.com/www.hocexcel.online