Sub loctudong()
Dim lr As Long
Dim i As Long
Dim j As Long
Dim c As Long
Dim rw() As Long
Dim sh As Worksheet
Set sh = Sheets("Du thau th")
lr = sh.Range("C5").End(xlDown).Row
ReDim rw(1 To lr)
For i = 33 To lr
c = 0
For j = i + 1 To lr
If UCase(sh.Range("D" & j).Value) = UCase(sh.Range("D" & i).Value) Then
c = c + 1
rw(c) = j
sh.Range("F" & i).Value = sh.Range("F" & i).Value + sh.Range("F" & j).Value
End If
Next j
If c <> 0 Then
ReDim Preserve rw(1 To c)
For j = c To 1 Step -1
sh.Rows(rw(j)).Delete
Next j
lr = sh.Range("C5").End(xlDown).Row
End If
Next i
End Sub
