Copy các dữ liệu sau khi đã thực hiện autofilter

[baihocdt]

Chào các anh/chị, mình cần copy các dữ liệu sau khi đã thực hiện autofilter để lưu sang một sheet khác, sau đó xóa các dòng này đi.
Các anh/chị xem giúp mình file đính kèm và hỗ trợ giúp nhé.
Cảm ơn ạ.

 

[alonelove]

Bạn thử:

Sub alonelove_GPE()
Application.DisplayAlerts = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As Worksheet
Set sht = Sheets("CONG_NO")
last = Sheets("CONG_NO").Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets("CONG_NO").Range("A2:G" & last)
Sheets("CONG_NO").Range("A2:G" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("HOANTAT").Range("A2"), Unique:=False
For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=7, Criteria1:="0"
.SpecialCells(xlCellTypeVisible).Copy
Sheets("HOANTAT").Paste
.SpecialCells(xlCellTypeVisible).Delete
End With
Next x
Sheets("CONG_NO").AutoFilterMode = False
Application.DisplayAlerts = True
End Sub

 

[be_09]

Chào các anh/chị, mình cần copy các dữ liệu sau khi đã thực hiện autofilter để lưu sang một sheet khác, sau đó xóa các dòng này đi.
Các anh/chị xem giúp mình file đính kèm và hỗ trợ giúp nhé.
Cảm ơn ạ.

Thử sử dụng Code cùi bắp (không dùng vòng lặp).

Sub Copy_VaXoaData()
    Sheet1.Range("A2", Range("P" & Rows.Count).End(xlUp)).AutoFilter Field:=7, Criteria1:="0"
    Sheet1.Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).Copy
    Sheet2.Range("A50000").End(xlUp).Offset(1).PasteSpecial
    Sheet1.Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    Sheet1.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("H1:H2"), Unique:=False
End Sub

 

[baihocdt]

Bạn thử:

Sub alonelove_GPE()
Application.DisplayAlerts = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As Worksheet
Set sht = Sheets("CONG_NO")
last = Sheets("CONG_NO").Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets("CONG_NO").Range("A2:G" & last)
Sheets("CONG_NO").Range("A2:G" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("HOANTAT").Range("A2"), Unique:=False
For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=7, Criteria1:="0"
.SpecialCells(xlCellTypeVisible).Copy
Sheets("HOANTAT").Paste
.SpecialCells(xlCellTypeVisible).Delete
End With
Next x
Sheets("CONG_NO").AutoFilterMode = False
Application.DisplayAlerts = True
End Sub

Cảm ơn bạn ạ.

 

[baihocdt]

Thử sử dụng Code cùi bắp (không dùng vòng lặp).

Sub Copy_VaXoaData()
    Sheet1.Range("A2", Range("P" & Rows.Count).End(xlUp)).AutoFilter Field:=7, Criteria1:="0"
    Sheet1.Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).Copy
    Sheet2.Range("A50000").End(xlUp).Offset(1).PasteSpecial
    Sheet1.Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    Sheet1.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("H1:H2"), Unique:=False
End Sub

Cảm ơn bạn, cho mình hỏi chút. Mình không muốn delete luôn các dòng vừa copy mà chỉ muốn xóa nội dung đi thôi, nhưng vẫn giữ nguyên các công thức ở các ô của các dòng này, để khi mình nhập thêm dữ liệu vào thì không phải nhập lại công thức thì làm sao ạ. Ví dụ Còn nợ= Tổng tiền - Đã thanh toán. (Thật sự bảng tính của mình còn nhiều cột và nhiều công thức liên quan khác nữa và Bảng tính của mình có 50 dòng có sẳn công thức ở các ô, mình muốn cố định luôn 50 dòng này)

Ngoài ra mình thấy, nếu nhấn nút lọc mà không có dòng nào thỏa mãn điều kiện thì vẫn bị xóa đi 1 dòng trắng bạn xem có thể điều chỉnh chỗ này cho không bị xóa được không ạ.
Cảm ơn bạn.