Filterresultaat afdrukken

[Aspheros]

Hallo iedereen


Ik zit met volgend probleem.

In een tabel filter ik in cel A1 op een bepaalde inhoud. Dit geeft in de tabel resultaten. Deze had ik graag afgedrukt.

Ik moet dit echter doen voor 100+ verschillende filterresultaten. Een per één selecteren en printen duurt me wat lang. Waarschijnlijk kan dit via een macro? Iemand die weet hoe?

Alvast bedankt!

 

[HSV]

Misschien is het interessant om je bestandje bij te voegen.

 

[Aspheros]

Beste HSV


Een voorbeeld vind je in bijlage.

De bedoeling is dus om in Kolom 1 (soort) te filteren op alle verschillende waarden en van elke resulterende selectie een afdruk te maken.
Met, zoals in dit voorbeeld, 8 verschillende waarden in kolom A lukt dit nog wel manueel maar er bestaat ongetwijfeld een snellere methode wanneer er 50 of meer verschillende waarden zijn om op te filteren.

Alvast bedankt

 

[Elsendoorn2134]

Aspheros,

Waarom zou je zo moeilijk doen.
- Sorteer de tabel op kolom 1
- Voeg einde pagina in na ieder soort (Lint: Pagina-indeling, Pagina-instelling, Einde markeringen, Pagina-einde invoegen)
- Print op iedere pagina de eerste regel (Lint: Pagina-indeling, Pagina-instelling, Titels afdrukken, Eerste regel aangeven)
Nu kun je in een printopdracht alle soorten op een aparte pagina afdrukken.

Bovenstaande kun je trouwens ook door een VBA code laten instellen.

Veel Succes.

 

[Aspheros]

Bedankt voor je antwoord. Met 100+ verschillende waarden duurt het instellen van paginaeinden ook een tijdje.

Ik probeer het aan te pakken met volgende macro maar er moet nog ergens een foutje zijn want ik krijg nog niet het gewenste resultaat.

Sub Afdrukken()
Dim noDupes As New Collection
Dim rw As Long
Dim itm As Variant
Selection.AutoFilter Field:=1
rw = ActiveSheet.AutoFilter.Range.Row
For Each cell In ActiveSheet.AutoFilter.Range.Columns(1).Cells
If cell.Row <> rw Then
On Error Resume Next
noDupes.Add cell.Value, cell.Text
On Error GoTo 0
End If
Next
For Each itm In noDupes
Selection.AutoFilter Field:=2, Criteria1:=itm
ActiveSheet.AutoFilter.Range.PrintOut
Next
End Sub

 

[WHER]

Misschien:

For Each itm In noDupes
Selection.AutoFilter Field:=[I][COLOR="#FF0000"][B]1[/B][/COLOR][/I], Criteria1:=itm
ActiveSheet.AutoFilter.Range.PrintOut
Next

 

[HSV]

Of:

Zet vooraf de pagebreaks op de goede plaats.

Sub hsv()
Dim i As Long, c, sn, dic
Application.ScreenUpdating = False
With Sheets("Blad1").ListObjects(1).DataBodyRange
 sn = .Value
 Set dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(sn)
      dic.Item(sn(i, 1)) = sn(i, 1)
    Next i
      For Each c In dic.keys
          .AutoFilter 1, c
          .Parent.PrintPreview  'veranderen in .parent.printout
          .AutoFilter
      Next c
 End With
End Sub

 

[Elsendoorn2134]

Aspheros,

Je macro is op zich goed maar in het tweede deel verwijs je in het filter naar kolom (field) 2 in plaats van field 1
Hierdoor gaat hij de voornaam filteren op soort en krijg je geen resultaten.

Veel Succes.