Data kopieren uit werkblad met autofilter

[Gerben84]

Ik wil in Excel met b.h.v een macro data kopieren uit een werkblad (Blad1), en deze data plaatsen onder de data die zich in een ander werkblad (maaiveld_0-250)bevind. Echter, niet alle data uit Blad1 wil ik kopiëren, alleen de gegevens die aan bepaalde voorwaarden voldoen. Daarom activeer ik hier een autofilter. Tot op heden gebruikte ik altijd onderstaande code, dat werkte altijd prima. Maar nu opeens gaat het fout...

Sheets("Blad1").Select
    Range("A2:H65535").Select
    Selection.AutoFilter
    Range("C3").Select
    Selection.AutoFilter Field:=4, Criteria1:="1"
    Selection.AutoFilter Field:=1, Criteria1:="<=250", Operator:=xlAnd, _
        Criteria2:=">0"
    Range("A3:C1000").Select
    Selection.Copy
    Sheets("maaiveld_0-250").Select
    Range("A2").Select
    Range("A1000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Nu is het zo dat alle data uit de opgegeven range gekopieerd wordt, ook al is deze in Blad1 niet zichtbaar doordat de autofilter hier aan staat. Weet iemand hoe ik automatisch alleen de gefilterde data netjes onderaan de gegevens in een ander werkblad kan plakken??

Alvast bedankt! :thumb:

 

[Wigi]

Werkt dit?

Sub data()
    With Sheets("Blad1").Range("A2:H" & Sheets("Blad1").Range("H" & Rows.Count).End(xlUp).Row)
        .AutoFilter
        .AutoFilter Field:=4, Criteria1:="1"
        .AutoFilter Field:=1, Criteria1:="<=250", Operator:=xlAnd, Criteria2:=">0"
        .Offset(1).SpecialCells(xlCellTypeVisible).Copy
    End With
    Sheets("maaiveld_0-250").Range("A1000").End(xlUp).Offset(1).PasteSpecial xlValues
    Application.CutCopyMode = False
End Sub

Wigi

 

[Gerben84]

Ik krijg steeds foutmelding 1004 wanneer deze opdracht uitgevoerd moet worden:

.Offset(1).SpecialCells(xlCellTypeVisible).Copy

 

[Wigi]

Hang eens een versimpelde versie van je bestandje bij hier. Doe vertrouwelijke gegevens uit.

 

[Gerben84]

Opgelost!

Wigi, bedankt voor je hulp! :thumb: Het is me uiteindelijk toch gelukt

Ik merkte dat mijn vorige code alleen niet aan mijn wensen voldeed, wanneer de eerste rij cellen al door de filter werd verborgen. De kopieeropdracht zorgde ervoor dat ook alle verborgen cellen werden gekopieerd. Alleen wanneer de eerste rij cellen wel zichtbaar bleef, en een aantal andere rij cellen werden verborgen, verliep het kopiëren van de zichtbare cellen wel goed..


Met de code

Selection.SpecialCells(xlCellTypeVisible).Select

kwam ik een heel stuk verder, alleen de foutmelding die ik daarna kreeg werd veroorzaakt doordat er toevallig geen cellen aan de voorwaarde voldeed en er dus niets te selecteren en kopiëren viel. Ik kopieer daarom nu één rij cellen meer dan waarvoor de filter zijn werk doet, zodat er altijd een zichtbare cel gekopieerd kan worden. Aangezien er in Blad1 nooit meer dan 1000 gegevens worden ingevuld, kopieer ik daarom nu de zichtbare cellen tot en met rij 1001.

Sheets("Blad1").Select
    Range("A2:I1000").Select

Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="<=250", Operator:=xlAnd
    Selection.AutoFilter Field:=5, Criteria1:="=1", Operator:=xlAnd
    
     
    Range("B3:D1001").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    
   
    Sheets("maaiveld_0-250").Select
    Range("A2").Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Bedankt! :thumb:

 

[Wigi]

OK, goed dat het opgelost is.