Lọc Từ bảng cố định chép kế tiếp vào sheet khác

[chucuoi92]

Mình có một bài nhờ các bạn viết dùm code lọc
Cám ơn các bạn nhiều!

 

[boyxin]

Mình có một bài nhờ các bạn viết dùm code lọc
Cám ơn các bạn nhiều!

bạn kiểm tra lại kết quả nhé

Sub GPE()
Dim Code As Range, Clls As Range
Set Code = Sheet1.[b3].Resize(Sheet1.[b3].End(xlDown).Row - 2)
Application.ScreenUpdating = False
For Each Clls In Code
    If (Len(Clls) = 1) And (Clls.Offset(, 3) = "") And (Clls.Offset(, 4) = "") Then
        Clls.EntireRow.Hidden = True
    End If
Next
With Sheet2.[a2].End(xlDown)
    Code.Offset(, -1).Resize(, 6).SpecialCells(12).Copy .Offset(1)
End With
    Code.EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

bạn kiểm tra lại kết quả nhé

Sao boyxin không dùng AutoFilter nhỉ?

 

[boyxin]

Sao boyxin không dùng AutoFilter nhỉ?

Hi, đọc kỹ lại yêu cầu thì thấy mình ngớ ngẩn thật

NHờ các bạn tạo một code loc
Lọc từ sheet1 theo cột A (loại bỏ dòng trống)
xóa dữ liệu cột E,F (không xóa dòng total)
Cám ơn các bạn nhiều!

Cữ nghĩ là loại bỏ dòng Blank ở cột E, F nhưng giữ lại dòng Total (giống như mẫu có sẵn bên sheet2)

 

[chucuoi92]

Cũng nghĩ tới AutoFilter + NonBlanks nhưng mắc chỗ giữ lại dòng có ToTal dù cho cột E, F là Blank Không muốn dùng cột phụ nên nhất thời chưa nghĩ ra điều kiện nên đành dùng tạm

Cám ơn anh rất nhiều!
Em thử code của anh thì rất tốt, chỉ có điều là code vẫn chưa xóa được dữ liệu cột E,F
Anh có thể giúp tiếp em tiếp không, xin nói thêm là những dòng total đó chỉ có hàm sum theo vùng thôi. vì bảng đó là bảng cố định không thay đổi dòng và cột ,Anh có thể dùng cách nào đó xóa hết, rồi điền lại hàm sum vào các ô cố định đó là OK!
Một lần nữa cám ơn các anh nhiều!
(TRong file em quên chưa tạo hàm sum cho các dòng total ở cột F).

 

[boyxin]

Cám ơn anh rất nhiều!
Em thử code của anh thì rất tốt, chỉ có điều là code vẫn chưa xóa được dữ liệu cột E,F
Anh có thể giúp tiếp em tiếp không, xin nói thêm là những dòng total đó chỉ có hàm sum theo vùng thôi. vì bảng đó là bảng cố định không thay đổi dòng và cột ,Anh có thể dùng cách nào đó xóa hết, rồi điền lại hàm sum vào các ô cố định đó là OK!
Một lần nữa cám ơn các anh nhiều!
(TRong file em quên chưa tạo hàm sum cho các dòng total ở cột F).

Mình không hiểu ý bạn nói đến xoá dữ liệu cột E, F là sao? Có phải là sau khi lọc sang sheet2 thì xoá dữ liệu tại cột E, F ở sheet1 nhưng dòng Total vẫn giữ nguyên công thức SUM. Thử dùng code này xem còn vấn đề gì thì trao đổi tiếp

Sub GPE()
Application.ScreenUpdating = False
With Sheet1.[a2].CurrentRegion.Offset(1)
    .AutoFilter Field:=1, Criteria1:="<>"
    .Offset(1).SpecialCells(12).Copy Sheet2.[a2].End(xlDown).Offset(1)
    .AutoFilter
    .Offset(1, 4).Resize(, 2).SpecialCells(2, 23).ClearContents
End With
Application.ScreenUpdating = True
End Sub

Hiện tại: Trong code mình làm như yêu cầu của bạn ghi trong sheet1

Lọc từ sheet1 theo cột A (loại bỏ dòng trống)
xóa dữ liệu cột E,F (không xóa dòng total)

Không xoá ô có công thức tại Cột E, F

 

[chucuoi92]

Mình không hiểu ý bạn nói đến xoá dữ liệu cột E, F là sao? Có phải là sau khi lọc sang sheet2 thì xoá dữ liệu tại cột E, F ở sheet1 nhưng dòng Total vẫn giữ nguyên công thức SUM. Thử dùng code này xem còn vấn đề gì thì trao đổi tiếp

Sub GPE()
Application.ScreenUpdating = False
With Sheet1.[a2].CurrentRegion.Offset(1)
    .AutoFilter Field:=1, Criteria1:="<>"
    .Offset(1).SpecialCells(12).Copy Sheet2.[a2].End(xlDown).Offset(1)
    .AutoFilter
    .Offset(1, 4).Resize(, 2).SpecialCells(2, 23).ClearContents
End With
Application.ScreenUpdating = True
End Sub

Hiện tại: Trong code mình làm như yêu cầu của bạn ghi trong sheet1Không xoá ô có công thức tại Cột E, F

Cám ơn anh đã vất vả giúp em!
Em chạy code thấy rất tốt (Anh đã hiểu được ý của em), nhưng có một số vấn đề phát sinh.
Thứ nhất: nếu xóa bỏ hết dữ liệu ở sheet2 (chỉ để lại dòng tiêu đề ) chạy code báo lỗi ở đoạn

.Offset(1).SpecialCells(12).Copy Sheet2.[a2].End(xlDown).Offset(1)

Thứ hai: trong trường hợp nhỡ bấm nhầm (chạy code) thêm lần 2 Khi không có số liệu nào thì báo lỗi ở:

.Offset(1, 4).Resize(, 2).SpecialCells(2, 23).ClearContents

Anh cố gắng giúp em thêm nhé!
Cám ơn anh!

 

[boyxin]

Cám ơn anh đã vất vả giúp em!
Em chạy code thấy rất tốt (Anh đã hiểu được ý của em), nhưng có một số vấn đề phát sinh.
Thứ nhất: nếu xóa bỏ hết dữ liệu ở sheet2 (chỉ để lại dòng tiêu đề ) chạy code báo lỗi ở đoạn

.Offset(1).SpecialCells(12).Copy Sheet2.[a2].End(xlDown).Offset(1)

Thứ hai: trong trường hợp nhỡ bấm nhầm (chạy code) thêm lần 2 Khi không có số liệu nào thì báo lỗi ở:

.Offset(1, 4).Resize(, 2).SpecialCells(2, 23).ClearContents

Anh cố gắng giúp em thêm nhé!
Cám ơn anh!

Mình nghĩ bạn dư sức sửa mấy chỗ lỗi này mà

Đoạn code sác định vị trí bắt đầu để chép kết quả LOC nối tiếp vào phần dữ liệu có sẵn

.Offset(1).SpecialCells(12).Copy Sheet2.[a2].End(xlDown).Offset(1)

sửa thành

.Offset(1).SpecialCells(12).Copy Sheet2.[a65535].End(xlup).Offset(1)

Đoạn code xoá dữ liệu cột E, F ở sheet1 sau khi LOC

.Offset(1, 4).Resize(, 2).SpecialCells(2, 23).ClearContents

Nếu nhấn nhầm thêm lần nữa thì vùng này không tồn tại nên không thể xoá
vậy thêm

On Error Resume Next

Cụ thể toàn bộ code sau khi sửa như sau

Sub GPE()
Application.ScreenUpdating = False
With Sheet1.[a2].CurrentRegion.Offset(1)
On Error Resume Next
    .AutoFilter Field:=1, Criteria1:="<>"
    .Offset(1).SpecialCells(12).Copy Sheet2.[a65535].End(xlUp).Offset(1)
    .AutoFilter
    .Offset(1, 4).Resize(, 2).SpecialCells(2, 23).ClearContents
End With
Application.ScreenUpdating = True
End Sub