[英]Filter data using Advanced Filter then copy to the bottom data in another table
I am working on a report that will filter data from a table, then copy that data into another sheet, and then delete the rows from the original table.我正在处理一份报告,该报告将从表中过滤数据,然后将该数据复制到另一张表中,然后从原始表中删除行。 Below is what I have so far, which works, however, I am not sure how to copy the filtered data into another sheet without erasing what was already there.
下面是我到目前为止所拥有的,它是有效的,但是,我不确定如何将过滤后的数据复制到另一个工作表中而不删除已经存在的数据。 I am new to VBA, so any notes in code would be appreciated.
我是 VBA 的新手,所以代码中的任何注释将不胜感激。 Thanks!
谢谢!
Sub International_Filter()
Dim Working As Range, IntULD As Range, Copyto As Range
' Working is the datatable that tracking numbers will be filtered, copied, and deleted
' INTULD is a list of criteria that needs to be filtered
' CopyTO is the sheet where the data will be copied
Set Working = Sheets("Working").Range("A1").CurrentRegion
Set IntULD = Sheets("OPC Exception").Range("M6").CurrentRegion
Set Copyto = Sheets("International").Range("A1").CurrentRegion
On Error Resume Next
Sheets("Working").ShowAllData
Working.AdvancedFilter xlFilterCopy, IntULD, Copyto
Working.AdvancedFilter xlFilterInPlace, IntULD
Range("A1").Select
If Range("A9999").End(xlUp).Address = "$A$1" Then
Exit Sub
Else
ActiveCell.Offset(1, 0).Select
If Cells(Columns("A").Rows.Count, "A").End(xlUp).Row > 2 Then
Range(selection, Cells(Columns("A").Rows.Count, "O").End(xlUp)).SpecialCells(xlCellTypeVisible).Select
End If
selection.EntireRow.Delete
End If
On Error Resume Next
Sheets("Working").ShowAllData
End Sub
How to insert filtered data at the beginning of a destination:如何在目的地的开头插入过滤后的数据:
Sub International_Filter()
Dim Source As Range ' Data to look at
Dim Data As Range ' Filtered data to copy
Dim Criteria As Range ' Criteria for Advanced Filter
Dim Destination As Range ' Place to copy filtered data
Dim Area As Range
Set Source = Sheets("Working").Range("A1").CurrentRegion
Set Criteria = Sheets("OPC Exception").Range("M6").CurrentRegion
Set Destination = Sheets("International").Range("A1")
With Source
.AdvancedFilter xlFilterInPlace, Criteria
On Error Resume Next
Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
.Parent.ShowAllData
If Data Is Nothing Then Exit Sub
For Each Area In Data.Areas
Area.Copy
Destination.Insert xlShiftDown
Next Area
Data.Delete xlShiftUp
End With
End Sub
ps From my point of view it's better to copy data at the end of existing data. ps 从我的角度来看,最好在现有数据的末尾复制数据。 So in this case the last part of the code is:
所以在这种情况下,代码的最后一部分是:
...
With Sheets("International").UsedRange
Set Destination = .Range("A1").Offset(.Rows.Count)
End With
...
If Data Is Nothing Then Exit Sub
Data.Copy Destination
Data.Delete xlShiftUp
...
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.