Nhờ chỉnh giúp vùng lọc dữ liệu trong code lọc (1 người xem)

Người dùng đang xem chủ đề này

diemdiem

Thành viên hoạt động
Tham gia
23/11/10
Bài viết
149
Được thích
7
Option Explicit
Dim Rws As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, cRit As Range

Set Sh = ThisWorkbook.Worksheets("HoSo")
Rws = Sh.[b65000].End(3).Row
If Not Intersect(Target, [L4]) Is Nothing Then
Set cRit = Range("AA1:AB2")
[AC5].Value = [AB5].Value
LocDS cRit
ElseIf Not Intersect(Target, [N4]) Is Nothing Then
Set cRit = Range("Ad1:Ae2")
[N3].Value = [AD5].Value
LocDS cRit
End If
End Sub

Sub LocDS(cRit As Range)

Sheets("HoSo").Range("B7:X7" & Rws).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=cRit, CopyToRange:=Range("B8:j8"), Unique:=False
End Sub

Sub LocDS ở trên, vùng lấy dữ liệu qua sheet DSLuong chỉ tới cột M, N, Q, em muốn vùng lấy dữ liệu không phải là 3 cột M, N, Q nữa vì đó là số liệu cũ, mà phải lấy 3 cột T, U, X (Dữ liệu mới). Giúp em thay đổi dữ liệu lại với ạ!
Em gửi kèm file nhé. Hihi, vui lòng đừng thay đổi dữ liệu gốc tội nghiệp em nhé.}}}}}
 

File đính kèm

Option Explicit
Dim Rws As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, cRit As Range

Set Sh = ThisWorkbook.Worksheets("HoSo")
Rws = Sh.[b65000].End(3).Row
If Not Intersect(Target, [L4]) Is Nothing Then
Set cRit = Range("AA1:AB2")
[AC5].Value = [AB5].Value
LocDS cRit
ElseIf Not Intersect(Target, [N4]) Is Nothing Then
Set cRit = Range("Ad1:Ae2")
[N3].Value = [AD5].Value
LocDS cRit
End If
End Sub

Sub LocDS(cRit As Range)

Sheets("HoSo").Range("B7:X7" & Rws).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=cRit, CopyToRange:=Range("B8:j8"), Unique:=False
End Sub

Sub LocDS ở trên, vùng lấy dữ liệu qua sheet DSLuong chỉ tới cột M, N, Q, em muốn vùng lấy dữ liệu không phải là 3 cột M, N, Q nữa vì đó là số liệu cũ, mà phải lấy 3 cột T, U, X (Dữ liệu mới). Giúp em thay đổi dữ liệu lại với ạ!
Em gửi kèm file nhé. Hihi, vui lòng đừng thay đổi dữ liệu gốc tội nghiệp em nhé.}}}}}
- Làm đại nha bạn test thử xem !!!
 

File đính kèm

Upvote 0

Bài viết mới nhất

Back
Top Bottom