Option Explicit
Sub FilterNext()
Dim Rng As Range, sRng As Range, Sh As Worksheet
Dim MyAdd As String, StrC As String
Dim Huong As Byte, Tung As Integer, Hoanh As Integer
Huong = InputBox("Hay Nhap 1 So tu 1 Den 8", "GPE Xin Luu Y:")
StrC = Choose(Huong, "Nam", "Bac", "Dong", "Tay", "D-Bac", "D-Nam", "T-Bac", "T-Nam")
MsgBox "Ban Da Chon Huong " & StrC
If Huong = 1 Or Huong = 6 Or Huong = 8 Then Hoanh = 1
If Huong = 2 Or Huong = 5 Or Huong = 7 Then Hoanh = -1
If Huong = 3 Or Huong = 5 Or Huong = 6 Then Tung = 1
If Huong = 4 Or Huong = 7 Or Huong = 8 Then Tung = -1
Set Rng = Selection: Set Sh = Sheet2
Set sRng = Rng.Find(1990, , xlFormulas, xlWhole)
Sh.[A1].Resize(Rng.Rows.Count, 9).ClearContents
Sh.[A1].Offset(, Huong - 1).Value = StrC
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
Sh.Cells(65500, Huong).End(xlUp).Offset(1).Value = sRng.Offset(Hoanh, Tung).Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
End Sub