Filteren kopieren plakken

[JanWL]

Hallo,

De volgende macro waar ik in het verleden mee geholpen ben, filtert, knipt en plakt. Ik zou nu graag zien dat hij filtert, kopieert en plakt.

Heeft iemand de oplossing?

Sub verplaatsen()
'
' verplaatsen Macro
' De macro is opgenomen op 25-10-2006 door Laar.
'

'


Dim rngAdvFilter As Range
Set rngAdvFilter = Range("A23:E80")
Application.ScreenUpdating = False
rngAdvFilter.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:e2"), Unique:=False
With Range("A24:e80").SpecialCells(xlCellTypeVisible)
    Sheets("br lunch arr").Rows("10:" & Intersect(Columns(1), .EntireRow).Cells.Count + 1).Insert shift:=xlDown
    .Copy Sheets("br lunch arr").Range("A9")
    .ClearContents
End With
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub

Alvast bedankt,

JanWL

 

[Wigi]

Doe de regel met

    .ClearContents

weg.

 

[JanWL]

Bedankt nog voor je hulp.

Heeft me goed verder geholpen.

Mvg.

JanWL:thumb: