Em xin nhờ các bác giúp em. Trong bảng tổng hợp của em là tổng hợp của rất nhiều các Công ty bây giờ em muốn tách theo dõi từng công ty ra từng bảng (Từ đó em có thể làm các sheet báo cáo riêng cho từng công ty. Xin cám ơn các bác.
Bạn xem trong file nhé
Muốn thế nào thì hãy post file lên mới có thể ... hợp lý và nhanh chóng
Theo tôi bạn nên nghiên cứu Advance Filter, và nghiên cứu tiếp 1 Code để làm chuyện này. So easy!
Bạn xem trong bài này nhé.Công thức độc đáo
Sub Loc()
Dim iDL, i As Long, j As Long, Er As Long
Dim Cty As String, iCty As String
Sheet1.Range("F2:H500").ClearContents
j = 2
Er = Range("Sheet1!A65000").End(xlUp).Row
For i = 2 To Er
Cty = Range("Sheet1!E1").Value
iCty = Range("Sheet1!B" & i & ":B" & i).Value
Set DL = Range("Sheet1!A" & i & ":C" & i)
Set KQ = Range("Sheet1!F" & j & ":H" & j)
If iCty = Cty Then
DL.Value = KQ.Value
j = j + 1
End If
Next
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [E1]) Is Nothing Then
Dim Cls As Range, Rng As Range, Rw As Long
Set Rng = Range([B3], [B65500].End(xlUp))
Rw = Rng.Rows.Count
[F2].Resize(Rw, 4).ClearContents
For Each Cls In Rng
If Cls.Value = Target.Value Then
Cls.Offset(, -1).Resize(, 3).Copy Destination:=Cells(Rw, "F").End(xlUp).Offset(1)
End If
Next Cls
End If
End Sub
Sub Loc()
1 Dim iDL, i As Long, j As Long, Er As Long
Dim Cty As String, iCty As String
3 Sheet1.Range("F2:H500").ClearContents
j = 2
5 Er = Range("Sheet1!A65000").End(xlUp).Row
For i = 2 To Er
7 Cty = Range("Sheet1!E1").Value
iCty = Range("Sheet1!B" & i & ":B" & i).Value
9 Set DL = Range("Sheet1!A" & i & ":C" & i)
Set KQ = Range("Sheet1!F" & j & ":H" & j)
11 If iCty = Cty Then
DL.Value = KQ.Value
13 j = j + 1
End If
15 Next
End SubSub Loc()
Dim iDL, i As Long, j As Long, eR As Long
Dim Cty As String, iCty As String
Sheet1.Range("F2:H500").ClearContents
eR = Range("Sheet1!A65000").End(xlUp).Row
Cty = Range("Sheet1!E1").Value
j = 2
For i = 2 To eR
iCty = Range("Sheet1!B" & i & ":B" & i).Value
Set DL = Range("Sheet1!A" & i & ":C" & i)
Set KQ = Range("Sheet1!F" & j & ":H" & j)
If iCty = Cty Then
KQ.Value = DL.Value
j = j + 1
End If
Next
End Sub
