Gefilterde cellen kopiëren naar een nieuw tabblad

[TMD]

Goedemorgen,

Ik heb onderstaande stukje code gevonden op internet en dat werkt perfect voor wat ik wil.

ActiveSheet.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)

Nou wil ik de delete veranderen naar .Copy, dit werkt echter niet. Ik wil alle getoonde cellen uit de filter kopieren naar een nieuw tabblad.

 

[JEC.]

ActiveSheet.Copy After:=Worksheets(Worksheets.Count)

Probeer dit eens na de filter te plaatsen

 

[TMD]

Hoi Jim,

Bedoel je dan in combinatie met de code die ik al heb? Alleen jouw code werkt niet helaas. Ik krijg dan enkel die tekst te zien in het werkblad.

 

[JEC.]

Sub kopieren()
ActiveSheet.AutoFilter.Range.Offset(1, 0).Copy
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
End Sub

Zo werkt het bij mij

 

[TMD]

Hoi Jim,

Bedankt voor de hulp, dit werkt ook voor mij!

Ik heb data staan in kolommen A-R.
Is er ook een manier dat ik het bereik van het kopiëren beperk tot kolommen A-D?

 

[JEC.]

Sub kopieren()
ActiveSheet.AutoFilter.Range.Offset(1, 0).Copy
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
Columns("E:R").Delete
End Sub

Zo?

 

[TMD]

Hoi Jim,

Ja dit is perfect. Bedankt voor je hulp

 

[jkpieterse]

Volgens mij doet de eerste regel uit die code uit bericht #6 niets en maakt regel 2 een complete kopie van het blad inclusief de filters. De "niet zichtbare" gegevens staan dus nog wel in dat blad.

 

[VenA]

Het verwijderen van kolommen is niet nodig. Gebruik .resize(,4).copy

Sub VenA()
  Cells(1).CurrentRegion.Offset(1).Resize(, 4).Copy
  Sheets.Add(, Sheets(Sheets.Count)).Paste
End Sub

Is natuurlijk geheel afhankelijk van de opzet van het niet geplaatste voorbeeldbestand. Een draaitabel lijkt mij logischer dan van alles in verschillende naamloze tabjes te zetten.