• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro voor filteren

  • Onderwerp starter Onderwerp starter JJH
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
J

JJH

Gebruiker
Lid geworden
26 sep 2008
Berichten
111
Hoi,

In bijgevoegd voorbeeld staan een aantal kolommen met gegevens.
Bekijk bijlage voorbeeld.xlsx

Wie kan me helpen? Ik zou graag met een druk op de knop de volgende acties doen:
1 A Nullen en lege cellen in kolom B eruit filteren
B cellenbereik tm laatste regel selecteren; tm eerstvolgende lege kolom (D)
C dit kopiëren en plakken in een nieuw sheet
D filtering weer verwijderen
2 stap 1 A tm D herhalen voor kolom E tm G
3 stap 1 A tm D herhalen voor kolom I tm K
4 stap 1 A tm D herhalen voor kolom M tm O

Is dit mogelijk ???

Alvast bedankt voor de hulp.
groeten,
Joyce
 
Code: 
Sub Filteren()
For K = 2 To 14 Step 4
    If Blad1.Range("A:A").SpecialCells(12).Count < Rows.Count Then Blad1.ShowAllData
    Blad1.Range("1:1").AutoFilter K, "<> ", xlAnd, "<>0"
    Worksheets.Add
    Blad1.Cells(1, K - 1).Resize(Blad1.Cells.SpecialCells(12).SpecialCells(11).Row, 3).Copy Range("A1")
Next
End Sub

Je hoeft alleen nog een knop op je werkblad te plaatsen en de code daaraan toe te voegen.

Met vriendelijke groet,


Roncancio
 
Als je wilt dat uit blad1 de filters weer verwijderd worden, moet je dit nog even toevoegen, tussen Blad1.Cells(1, K - 1).Resize(Blad1.Cells.SpecialCells(12).SpecialCells(11).Row, 3).Copy Range("A1")en next

Code: 
With Blad1

            .AutoFilterMode = False

            .Range("A1:N1").AutoFilter

    End With

En die knop heb ik ook maar even toegevoegd

Bekijk bijlage voorbeeld-4.xlsm
 
Laatst bewerkt:
De filter hoef je niet te verwijderen.
Je moet alleen zorgen dat alle verborgen rijen weer zichtbaar worden en dat gebeurt al met Blad1.ShowAllData in mijn code.
Je toegevoegde code is dus overbodig.

Goed dat je de knop toevoegt maar dit is wel een voorbeeldbestand.

Met vriendelijke groet,


Roncancio
 
De filter verdwijnt niet aan het eind van de code @Roncancio.
 
Zo hebben we geen last van het filter.

Code: 
Sub VenA()
  For Each ar In Sheets("Blad1").Rows(1).SpecialCells(2).Areas
    With ar.Resize(Sheets("Blad1").UsedRange.Rows.Count)
      .AutoFilter 2, "<> ", xlAnd, "<>0"
      Sheets.Add , Sheets(Sheets.Count)
      .Copy Range("A1")
      .AutoFilter
    End With
  Next ar
End Sub
 
Het criterium niet lege velden is officieel "<>" en het verbaast me dat "<>spatie" ook werkt.
 
Hoi Allemaal, super bedankt voor de hulp. @janBG, zoals het in jou voorbeeld werkt, werkt het prima! het filter is daarna ook weer verdwenen en de juiste data zijn gekopieerd.
Nu dacht ik het alleen daarna zelf wel even in mijn uiteindelijke bestand te krijgen dat iets uitgebreider is natuurlijk. Helaas lukt dit niet helemaal.
Mag ik jullie nog eens om jullie hulp vragen in bijgevoegd bestand ?

Bekijk bijlage voorbeeld 2.xlsx

kolom A tm P moet in een sheet komen dmv uitfilteren van de nullen en lege rijen in kolom F
Idem voor kolom R tm AG met filter in kolom W
Idem voor kolom AI tm AW en filter in kolom AN
Als laatste kolom AZ tm BO met het filter in kolom BE

Ik hoop dat dit voldoende info is.

Alvast heel erg bedankt.
Groeten,
Joyce
 
Laatst bewerkt:
Wat lukt er dan niet?

Code: 
Sub VenA()
  For Each ar In Sheets("Inleesbestand").Rows(4).SpecialCells(2).Areas
    With ar.Resize(Sheets("Inleesbestand").UsedRange.Rows.Count)
      .AutoFilter 5, "<>", xlAnd, "<>0"
      Sheets.Add , Sheets(Sheets.Count)
      .Copy Range("A1")
      .AutoFilter
    End With
  Next ar
End Sub
 
Dankje.

Ik heb nog een paar problemen nu:
- hij neemt met kopieren rij 1 tm 3 niet mee, deze moeten er wel bij
- hij neemt de eerste kolom steeds niet mee (kolom A; R; AI en AZ)
- hij gooit het filter er nu helemaal uit. Hij moet de selectie verwijderen maar het autofilter wel op de rij laten staan. Dit ging in het vorige voorbeeld wel goed.

Daarnaast zou ik sheet willen aanpassen naar workbook. Dit had ik in het eerste voorbeeld gedaan en werkte goed, maar nu lukt het me niet.

Wat er trouwens niet lukte in de vorige, nadat ik hem in mijn eigen bestand had gezet voerde hij de macro wel uit, maar op een heel ander tabblad met een totaal andere naam ook. Dan knipte hij dan wel heel mooi op :-D maar ik had er niet zoveel aan.... Ook kopieerde hij dan die 3 kolommen en ik wist niet hoe ik dan kon aanpassen.

alvast bedankt.
gr
Joyce
 
Laatst bewerkt:
Hoi,
Je tweede probleem is makkelijk op te lossen door in de cellen A4, R4, AI4 en AZ4 ook een "Q" te plaatsen, dan neemt ie de kolommen gewoon mee.
Rest kost wat meer moeite, ga ik naar kijken.
 
Oeps..., als je dat doet neemt ie de kolommen wel mee, maar filtert ie de nullen er niet meer uit. We zoeken een andere oplossing
 
Zo zou het moeten werken;

Code: 
Sub Filter()
For K = 6 To 63 Step 17
    Blad1.Range("4:4").AutoFilter K, "<>", xlAnd, "<>0"
    Worksheets.Add
       
    Blad1.Cells(1, K - 5).Resize(Blad1.Cells.SpecialCells(12).SpecialCells(11).Row, 12).Copy Range("A1")
    
    With Blad1

            .AutoFilterMode = False

            .Range("A4:BO4").AutoFilter

    End With
    
Next


End Sub

Bekijk bijlage Test.xlsm


Succes!
 
Nog vergeten, als je van de gefilterde dat workbooks wil maken in plaats van sheets, moet in de code "WorkSheets.Add" wijzigen in "Workbooks.Add".
 
Hoi,

Net nog even een check gedaan en er bleek toch nog een klein foutje in de code te zitten, waardoor niet alle gewenste kolommen werden gekopieerd. De juiste code is:

Code: 
Sub Filter()
For K = 6 To 63 Step 17
    Blad1.Range("4:4").AutoFilter K, "<>", xlAnd, "<>0"
    Worksheets.Add
       
    Blad1.Cells(1, K - 5).Resize(Blad1.Cells.SpecialCells(12).SpecialCells(11).Row, 15).Copy Range("A1")
    
    With Blad1

            .AutoFilterMode = False

            .Range("A4:BO4").AutoFilter

    End With
    
Next


End Sub

Groet, Jan
 
Bijna goed je mist nog 1 kolom;) (ik was net een berichtje aan het tikken om je erop te wijzen)

Nb. SpecialCells(12) is niet echt nodig en mag je weglaten.
 
Laatst bewerkt:
17-1 valt toch wel mee:d

Iets anders geschreven
Code: 
Sub Filter()
  With Blad1
    For K = 6 To 63 Step 17
      .Rows(4).AutoFilter K, "<>", xlAnd, "<>0"
      Worksheets.Add
      .Cells(1, K - 5).Resize(.Cells.SpecialCells(11).Row, 16).Copy Range("A1")
      .AutoFilterMode = False
    Next
    .Rows(4).AutoFilter
  End With
End Sub

Of voortbordurend op mijn code
Code: 
Sub VenA()
  For Each ar In Sheets("Inleesbestand").Rows(4).SpecialCells(2).Areas
    With ar.Offset(-3, -1).Resize(Sheets("Inleesbestand").UsedRange.Rows.Count, ar.Columns.Count + 1)
      .Offset(3).AutoFilter 6, "<>", xlAnd, "<>0"
      .Copy Sheets.Add(, Sheets(Sheets.Count)).Cells(1)
      .AutoFilter
    End With
  Next ar
  Sheets("Inleesbestand").Rows(4).AutoFilter
End Sub


Daarnaast zou ik sheet willen aanpassen naar workbook. Dit had ik in het eerste voorbeeld gedaan en werkte goed, maar nu lukt het me niet.
Klik om te vergroten...
Wat bedoel je hiermee? Per groep kolommen een nieuw bestand of alles in een nieuw bestand? In het eerste voorbeeld heb je niets gedaan.
 
@Vena
Zie nog niet een twee drie waarom, maar als ik jou code gebruik, krijg ik een 'door object gedefinieerde foutmelding'. :mad:
 
Volgens mij werken beide procedures. Op welke regel krijg je de foutmelding?

Edit, Je hebt toch niet in A4 een Q gezet? Dan gaat de offset (-3,-1) natuurlijk fout.
 

Bijlagen

Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan