Dump tabblad uitfilteren

[ambroz]

Ik heb een 500-tal vragen in een tabblad staan, gecategoriseert in 10 categorien.
Ik wil graag voor iedere categorie een nieuw tabblad, zodat er per categorie duidelijk een tabblad is met de vragen erin.
Ik heb geprobeerd om alles uit het "dump" tabblad te linken naar de verschillende tabbladen, en dan uit te filteren met een filter.
Helaas werken de links naar interne bestanden dan niet meer.

Wie kan me helpen?
Zie het voorbeeld voor een kleine lijst met (fake) vragen.

 

[spaarie]

Plak onderstaande in een module

Sub Spaarie()
    Dim uniekewaarden As New Collection
    Dim ws As Worksheet
    
    Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "dump" Then sh.Delete
    Next
    Application.DisplayAlerts = True

    With Sheets("dump")
        On Error Resume Next
        For Each c In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            uniekewaarden.Add c.Value, CStr(c.Value)
        Next c
        On Error GoTo 0
        
        For Each waarde In uniekewaarden
            .UsedRange.AutoFilter 1, waarde
            .Range("A1:F" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
            Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count))
            With ActiveSheet
                .Paste
                .Cells(1).Select
                .Cells.EntireColumn.AutoFit
                .Name = Range("A2")
            End With
        Next waarde
        .UsedRange.AutoFilter
    End With
    Application.Goto Sheets("dump").Cells(1)
End Sub

 

[ambroz]

Thanks Spaarie!
Had hier totaal niet aan gedacht. Nu even de macro aanpassen zodat de opmaak er fatsoenlijk uitziet, maar voor nu, harstikke dank!

 

[ambroz]

Spaarie, het lukt me niet om de op naam goed te krijgen. Ik wil de breedte op 45 en de hoogte wrappen.
Daarnaast weet ik niet of het handig is om iedere keer de tabbladen te verwijderen, om ze vervolgens weer te creeeren. Is hier geen maxmium aan? Ik wil dagelijks update en het zijn zo'n 500 vragen....
Is het daarnaast ook mogelijk om een tabblad te maken waarin de vragen op datum zijn gesorteerd, zodat mij medewerkers kunnen zien welke vragen als laatst zijn toegevoegd?

Mijn dank is bij voorbaat (zeer) groot ;-)

 

[spaarie]

het lukt me niet om de op naam goed te krijgen

Dit moet je toch even nader uitleggen

Ik wil de breedte op 45 en de hoogte wrappen

Breedte van de kolom stel je in met .ColumnWidth, maar de hoogte wrappen? Voor rijhoogte is in ieder geval geen standaard functie.

Daarnaast weet ik niet of het handig is om iedere keer de tabbladen te verwijderen, om ze vervolgens weer te creeeren. Is hier geen maxmium aan? Ik wil dagelijks update en het zijn zo'n 500 vragen....

Licht het eens toe waarom het niet handig zou zijn. Het wordt gefilterd op categorie dus het aantal vragen doet er toch niet toe? Het gaat om het aantal categorieen... als je hier 500 van hebt is het een ander verhaal.

Is het daarnaast ook mogelijk om een tabblad te maken waarin de vragen op datum zijn gesorteerd

Dat is mogelijk, maar laten we eerst je bovenstaande vragen uitpluizen...

 

[ambroz]

Bedankt voor je bericht Spaarie!

het lukt me niet om de op naam goed te krijgen

Ik denk dat ik iets anders heb geschreven dan ik dacht. Moest zijn op de opmaak goed te krijgen.

Daarnaast weet ik niet of het handig is om iedere keer de tabbladen te verwijderen, om ze vervolgens weer te creeeren. Is hier geen maxmium aan? Ik wil dagelijks update en het zijn zo'n 500 vragen....

Ik had het idee dat dit niet oneindig zal gaan (max aantal gecreerde tabbladen). Wellicht heb ik me vergist omdat steeds de oude gedelete worden.


Wat betreft de breedte: breedte van question NL, question ENG en antwoord ENG kan op 45, Link kan op 25.
Wat betreft de bhoogte: zo hoogte dat hij met bovengenoemde breedte leesbaar is (wrap text??)

 

[spaarie]

Better?

Sub Spaarie()
    Dim uniekewaarden As New Collection
    Dim ws As Worksheet
    
    Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "dump" Then sh.Delete
    Next
    Application.DisplayAlerts = True
    
    With Sheets("dump")
        On Error Resume Next
        For Each c In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            uniekewaarden.Add c.Value, CStr(c.Value)
        Next c
        On Error GoTo 0
        
        For Each waarde In uniekewaarden
            .UsedRange.AutoFilter 1, waarde
            .Range("A1:F" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
            Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count))
            With ActiveSheet
                .Paste
                .Cells(1).Select
                .Range("A:A,F:F").Columns.AutoFit
                .Range("B:D").ColumnWidth = 45
                .Range("E:E").ColumnWidth = 25
                .UsedRange.WrapText = True
                .Name = Range("A2")
            End With
        Next waarde
        .UsedRange.AutoFilter
    End With
    Sheets("dump").Copy , Sheets("dump")
    
    With ActiveSheet
        .Name = "Dump gesorteerd"
        .Range("F1").Sort .Range("F1"), xlDescending
    End With

    Application.Goto Sheets("dump").Cells(1)
End Sub

 

[ambroz]

Dankje Spaarie. Ziet er al een stuk beter uit! Ik kom alleen de volgende foutmelding tegen:

.Name = Range("A2")

Deze komt in het geel, en geef een bug aan (error 1004)
Heb jij hiervoor een verklaring? Ik kan het zo 1,2,3 niet vinden

 

[spaarie]

Misschien puntje per ongeluk weggehaald...

.Name = [COLOR="#FF0000"].[/COLOR]Range("A2")

 

[ambroz]

Hij pakt hem nog steeds niet... vreemd

 

[spaarie]

Op je voorbeeldbestand werkt ie gewoon...

 

[ambroz]

Thanks Spaarie. Ik heb het probleem al gevonden voor mijn echte bestand!
Mijn dank is echt heeeeel groot!!!

 

[spaarie]

Graag gedaan. Ken je de vraag ook nog als opgelost zetten?
Bij voorbaat dank!