Option Explicit
Sub TongHop()
On Error Resume Next
Dim Sh As Worksheet, Rng As Range, Clls As Range, sRng As Range
Dim MyAdd As String, Kho As String
Dim eRw As Long, Cot As Byte
Set Sh = Sheets("NKNX"): eRw = Sh.[B65500].End(xlUp).Row
Sh.Range("G7:P" & eRw).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range( _
"V2:V3"), CopyToRange:=Sh.Range("U7:Y7"), Unique:=False
Sh.Range("V7:V" & eRw).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sh.[AA7], Unique:=True
Range("B11:X" & eRw).ClearContents
Sh.Range(Sh.[AA8], Sh.[aa65500].End(xlUp)).Copy Destination:=[b11]
Set Rng = Sh.Range(Sh.[v7], Sh.[v7].End(xlDown))
For Each Clls In Range([b11], [b11].End(xlDown))
Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
With Clls.Offset(, 1)
.Value = sRng.Offset(, 1).Value
.Offset(, 1).Value = sRng.Offset(, 2).Value
End With
Do
Kho = Right(sRng.Offset(, -1), 2)
If Left(sRng.Offset(, -1).Value, 1) = "N" Then
Cot = Switch(Kho = "MU", 4, Kho = "CK", 5, Kho = "TH", 9)
With Clls.Offset(, Cot)
.Value = .Value + sRng.Offset(, 3).Value
End With
ElseIf Left(sRng.Offset(, -1).Value, 1) = "X" Then
Cot = Switch(Kho = "TC", 12, Kho = "CK", 13, Kho = "KH", 17)
With Clls.Offset(, Cot)
.Value = .Value + sRng.Offset(, 3).Value
End With
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next Clls
End Sub
