Option Explicit
Sub Loc_Co_DK()
Dim srcRng As Range, findRng As Range
Dim CellAddress As String, Count As Long
ReDim ArrIndex(1 To 1)
With Sheet2
Set srcRng = Sheet1.Range(Sheet1.[C2], Sheet1.[C65536].End(xlUp))
Set findRng = srcRng.Find(.[C3], LookIn:=xlValues, LookAt:=xlWhole)
.[B8:F1000,C4,C5,C6].ClearContents
If findRng Is Nothing Then
MsgBox "Khong co so phieu nay!", , "Coi Lai!!!!"
.[C3].ClearContents
Else
CellAddress = findRng.Address
.[C4] = findRng.Offset(, -1).Value
.[C5] = findRng.Offset(, 1).Value
.[C6] = findRng.Offset(, 2).Value
Do
Count = Count + 1
With .[b99].End(xlUp).Offset(1)
.Value = Count
.Offset(, 1).Value = findRng.Offset(, 3).Value
.Offset(, 2).Resize(, 2).Value = findRng.Offset(, 5).Resize(, 2).Value
End With
Set findRng = srcRng.FindNext(findRng)
Loop Until findRng.Address = CellAddress
End If
Set findRng = Nothing: Set srcRng = Nothing
End With
End Sub
Ngoài cách của Chị HYen17 ra, tôi viết cho bạn trên mảng:
Sub Loc_co_dk()
Dim r As Long
r = Sheet1.Range(Sub SuaSLX()
Dim TenHH As Range, Count As Long
Application.ScreenUpdating = False
Set TenHH = Sheet2.[C65536].End(xlUp)
Do While TenHH.Row > 7
Count = Count + 1
Sheet1.Range("I" & ArrIndex(UBound(ArrIndex) - Count + 1)).Value = TenHH.Offset(, 2).Value[B][COLOR=#ff0000]<----bị vàng chổ này[/COLOR][/B]
Set TenHH = TenHH.Offset(-1)
Loop
MsgBox ("Sua phieu xong")
SortNgay
Sheet9.[B8:F1000,C3,C4,C5,C6].ClearContents
Application.ScreenUpdating = True
End Sub
----------------------------------------------------------------------------------------------------------------
Sub SortNgay()
Dim Vung As Range
With Sheet1
Set Vung = .Range(.[B65536].End(xlUp), .[I2])
Vung.Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=
xlGuess , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End SubSorry, giờ tôi phải về nhà (đang trực tại cơ quan), có gì nếu không ai giúp thì mai tôi sẽ giúp cho bạn.
