Advanced filter with cut data instead of copy?

  • Thread starter Thread starter Yariev
  • Start date Start date
Y

Yariev

I am using the advanced filter - Sub ABC (see below) - for transferin
data from 1 input-sheet to various different sheets. However usin
advanced filter, the data is copied to other sheets. Is it possible t
have this cut or moved instead of copied and how can I do this?

Can someone help with this, thnx!


Sub ABC()

Sheets("Blad1").Range("A1:C21").AdvancedFilter Action:=xlFilterCopy,

CriteriaRange:=Sheets("Blad2").Range("A1:C2")
CopyToRange:=Range("A1"), _
Unique:=False
Sheets("Blad B").Select
Sheets("Blad1").Range("A1:C21").AdvancedFilter Action:=xlFilterCopy,

CriteriaRange:=Sheets("Blad2").Range("A4:C5")
CopyToRange:=Range("A1"), _
Unique:=False
Sheets("Blad C").Select
Sheets("Blad1").Range("A1:C21").AdvancedFilter Action:=xlFilterCopy,

CriteriaRange:=Sheets("Blad2").Range("A7:C8")
CopyToRange:=Range("A1"), _
Unique:=False

End Su
 
Maybe you could filter in place, copy the visible cells, paste those visible
cells, then delete the visible rows--but not the header:

This may give you an idea:

Option Explicit
Sub ABCD()

With Worksheets("blad1")
.Range("a1:c21").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Worksheets("blad2").Range("A1:C2"), Unique:=False

.Range("_filterDataBase").Cells.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("blad A").Range("a1")

With .Range("_filterDataBase")
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _
.Cells.Count > 1 Then
.Resize(.Rows.Count - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
End With

.ShowAllData

End With

End Sub

(it only does one of the filters.)
 
Back
Top