Sub CopyDuLieu()
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long, destRow As Long
Dim dict As Object
Dim sourceRange As Range, destRange As Range
Dim cell As Range
Dim sourceRow As Range
Dim key As Variant
' Gán các worksheet cho bien
Set wsSource = ThisWorkbook.Sheets("Raw")
Set wsDestination = ThisWorkbook.Sheets("xuat")
' Xóa du lieu hien có trên Xuat, nhung không xóa tiêu d? c?t
wsDestination.Rows("3:" & wsDestination.Rows.Count).ClearContents
' Kh?i t?o dictionary d? luu tr? s? l?n xu?t hi?n c?a m?i giá tr? trong c?t C
Set dict = CreateObject("Scripting.Dictionary")
' T́m hàng cu?i cùng trong c?t C c?a Sheet1
lastRow = wsSource.Cells(wsSource.Rows.Count, "J").End(xlUp).Row
' L?p qua d? li?u trên c?t C c?a Sheet1 và t?o danh sách các hàng c?n xu?t
For i = 4 To lastRow
If Not dict.exists(wsSource.Cells(i, "J").Value) Then
' N?u giá tr? chua t?n t?i trong dictionary, thêm vào dictionary
dict.Add wsSource.Cells(i, "J").Value, 1
Else
' N?u giá tr? dă t?n t?i trong dictionary, tang s? l?n xu?t hi?n lên 1
dict(wsSource.Cells(i, "J").Value) = dict(wsSource.Cells(i, "J").Value) + 1
End If
Next i
' Xu?t các hàng t? danh sách c?n xu?t ra Sheet2
destRow = 3 ' B?t d?u t? hàng th? 2 trên Sheet2
For Each key In dict.keys
If dict(key) > 1 Then
' Xu?t t?t c? các hàng n?u có mă trùng
For i = 1 To lastRow
If wsSource.Cells(i, "J").Value = key Then
Set sourceRange = wsSource.Rows(i)
sourceRange.Copy wsDestination.Rows(destRow)
destRow = destRow + 1
End If
Next i
End If
Next key
' Xóa d?i tu?ng dictionary kh?i b? nh?
Set dict = Nothing
MsgBox "Hoàn thành!"
End Sub
