Export met filter

[toyjanssen]

Ik wil een code maken die mij in staat stelt een export te maken op basis van een filter. Zie voorbeeld sheet. In tabblad "tabel" moeten de cellen in kolom3 gekopieerd worden die de waarde "waar" hebben in kolom4. Deze moeten in het tabblad sjbloon komen te staan. Bekijk bijlage test.xlsx

 

[Niels28]

Sub export()
For Each cl In Sheets("tabel").Range("D:D").SpecialCells(2)
If UCase(cl.Value) = "WAAR" Then
c01 = c01 & "|" & cl.Offset(0, -1).Value
End If
Next
Sheets("sjabloon").Range("d4").Resize(UBound(Split(c01, "|")), 1) = WorksheetFunction.Transpose(Split(Mid(c01, 2), "|"))
End Sub

Niels

 

[toyjanssen]

Hi Niels,

Bedankt voor de snelle reactie (ik kom overigens uit uden, dichtbij), dit werkt. Indien ik nu meer dan 34 regels kopieer dan valt de rest buiten het sjabloon. Is hier een oplossing voor? Is het ook mogelijk om de opmaak van de cellen mee te kopieren?

 

[Niels28]

Dan duur ie wel iets langer.
Ik gebruik kolom A op blad sjabloon als hulp kolom anders weet ik niet hoe ik het op moet delen in 4 kolommen.

Sub Macro1()
    Application.ScreenUpdating = False
    Lrow = Sheets("tabel").Cells(Rows.Count, "A").Row
    With Sheets("tabel").Range("A1:D" & Lrow)
        .AutoFilter
        .AutoFilter Field:=4, Criteria1:=True
        Sheets("tabel").Range("C2:C" & Lrow).SpecialCells(12).Copy Sheets("sjabloon").Range("A4")
        .AutoFilter
    End With
    With Sheets("sjabloon")
        .Range("A4:A37").Copy .Range("D4")
        .Range("A38:A71").Copy .Range("F4")
        .Range("A72:A105").Copy .Range("H4")
        .Range("A106:A139").Copy .Range("J4")
        .Range("A:A").SpecialCells(2).Delete shift:=xlUp
        End With
    Application.ScreenUpdating = True
End Sub

Niels

 

[toyjanssen]

Ik krijg een foutmelding bij regel: .Range("A:A").SpecialCells(2).Delete shift:=xlUp

 

[Niels28]

Bij mij niet, krijg je het in het bestandje volgens bijlage ook?
Heb hem nog wel aangepast omdat ik ook lege cellen mee kopieerde, nu niet meer.

Bekijk bijlage test (3).xlsm

Niels

 

[toyjanssen]

krijg nu een foutmelding op regel: Sheets("tabel").Range("C2:C" & Lrow).SpecialCells(12).Copy Sheets("sjabloon").Range("A4") Ik gebruik excel 2010 (nl versie). Hij geeft als foutmelding:fout 1004 tijdens uitvoering: er zijn geen lege cellen gevonden. Als ik bij foutmelding beeindig kies dan is in tabblad "tabel" de filter ingeschakeld maar er zijn geen waarden ingesteld. In het tabblad sjabloon is alleen cel c1 (tekst kolom3) van tabblad tabel gekopieerd.

 

[Niels28]

En nu?

Ik heb kolom D de celeigenschappen op tekst gezet omdat deze anders bij mij gezien worden als true/false.
Nu wordt er op het specifiek op het woord Waar gefilterd.

Bekijk bijlage test (4).xlsm

Niels

 

[toyjanssen]

Dit werkt, harstikke bedankt!!

 

[Niels28]

Zet je de vraag dan op opgelost.

Niels