autofilter zichtbaar maken bij verplaatsen gegevens tussen sheets

[live01]

Hallo,

Met onderstaande code verplaats ik data van ene sheet naar andere sheet. ik wil dat de titels van verplaatste gegevens de autofilter pijlen bevatten, zodat ik achteraf de gegevens kan filteren.

kan iemand me hiermee helpen? alvast dank

code:

Private Sub cmdLoad_Click()

Dim wsName As String
Dim mySh As Worksheet
Dim newsh As Worksheet
Set newsh = ThisWorkbook.Sheets("rapport")
Set mySh = ThisWorkbook.Sheets("Rapportbron")

Dim countselected As Integer: countselected = 0
Dim col_name As String
Dim col_count As Integer: col_count = 4


Application.ScreenUpdating = False

newsh.Unprotect
newsh.Cells.Clear
newsh.Columns("D:Z").EntireColumn.Delete
newsh.Columns.UseStandardWidth = True
newsh.Rows.UseStandardHeight = True
newsh.Rows.RowHeight = 15
newsh.Columns.ColumnWidth = 8.71



For i = 0 To Me.ListBox2.ListCount - 1
    If Me.ListBox2.Selected(i) Then
        col_name = Me.ListBox2.List(i)
        countselected = countselected + 1
        
        For a = 1 To mySh.Cells(1, Columns.Count).End(xlToLeft).Column
            If mySh.Cells(1, a).Value = col_name Then
                
                'copy the data from raw to new worksheet created
                
                For b = 1 To mySh.Cells(Rows.Count, a).End(xlUp).Row
                newsh.Cells(b, col_count).Value = mySh.Cells(b, a).Value
                '// Autofit Columns
                newsh.Cells.EntireColumn.AutoFit
                '// Format Table Headers
                newsh.Cells(1, col_count).Resize(1, 1).Interior.Color = RGB(233, 233, 233)
                newsh.Cells(1, col_count).Resize(1, 1).Font.Bold = True
                newsh.Cells(1, col_count).Resize(1, 1).HorizontalAlignment = xlCenter
                newsh.Cells(1, col_count).Resize(1, 1).VerticalAlignment = xlBottom
                
                
                Next b
                col_count = col_count + 1
             End If
         Next a
     End If
Next i

Application.ScreenUpdating = True
MsgBox "Data Loaded", vbInformation
newsh.Activate
newsh.Range("C2:G6").Select

    Selection.Locked = False
    Selection.FormulaHidden = False

newsh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
newsh.Range("D5").Select

End
End Sub

 

[alphamax]

Ongeveer op deze manier

Range("A1:M3").AutoFilter

Zet je de autofilter op een range

Maar met een klein anoniem voorbeeldbestandje wordt je sneller en beter geholpen.

 

[live01]

Bedankt voor je snelle reactie!

kun je aangeven tussen welke regel deze code geplaatst moet worden.
ter info: de gegevens worden geplakt in de vierde regels kolom D.

thanks!
Bekijk bijlage 356130Bekijk bijlage 356130

 

[live01]

Hier een bestandje met voorbeeld. zodra de data wordt verplaatst naar tabblad "rapport", wil ik alle kolommen kunnen filteren.


Bekijk bijlage Example.xlsm

 

[huijb]

Verplaatst naar Excel en code tussen codetags gezet.

 

[alphamax]

    Next i

    [COLOR="#FF0000"]newsh.Cells(4, 4).CurrentRegion.AutoFilter[/COLOR]

    Application.ScreenUpdating = True

Rode tekst toevoegen tussen zwarte tekst

 

[live01]

Het werkt.....je bent geweldig Alphamax!

Thanks a lot

 

[live01]

Hi Alphamax,

Nog een vraagje. Hoe kan ik aangeven dat ik specifieke term niet in de listbox wil hebben. bijvoorbeeld "Leeg". ik heb een tabel met titels die ik niet zichtbaar wil hebben in de listbox, en ook niet wil verwijderen.

zie voorbeeld image

 

[alphamax]

Aan de .autofilter kan je niets instellen.

 

[live01]

Ik wil ook niets aan autofilter doen. ik wil dat de listbox een paar kolommen negeert met bepaalde benamingen zoals "veld" of "leeg". dus een kolom met koptekst die bevat "veld" moet niet verschijnen in de listbox.
Bekijk bijlage 356140

 

[alphamax]

Ik kan je bijlagen niet openen, dit is een fout van het forum (want jij kan wel zelf je eigen bijlages openen).
Kan je niet op een andere manier uploaden? Het bestand uit bericht#4 kan ik wel downloaden.

Heb jij de code zelf geschreven of ergens anders vandaan? het lijkt erop dat je eigen bestand niet snapt.
< of > is een blauwe titel verplaatsen,<< of >> is alle titels verplaatsen.

 

[live01]

is het goed zo?

(code heb ik ergens vandaan, maar heb wat dingen veranderd zoals ik het wil hebben. maar kon niet alles zelf doen, vandaar hulp gezocht)

 

[alphamax]

Laat maar, ik denk dat je dit bedoelt (je moet wel nog wat spelen met kleine en hoofdletters)

Private Sub UserForm_Initialize()

    [COLOR=#FF0000]aExclude = Array("veld", "leeg")[/COLOR]

    Set mySh = ThisWorkbook.Sheets("Rapportbron")

    For a = 1 To mySh.Cells(4, Columns.Count).End(xlToLeft).Column
        With Me.ListBox1
            [COLOR=#FF0000]For iaExclude = LBound(aExclude) To UBound(aExclude)
                If mySh.Cells(4, a).Value = aExclude(iaExclude) Then
                    GoTo ExcludeFound
                End If
            Next[/COLOR]
            .AddItem mySh.Cells(4, a).Value
        End With
[COLOR=#FF0000]ExcludeFound:[/COLOR]
    Next a

End Sub

 

[live01]

Gelukt! thanks again!

 

[VenA]

Waarom zo ingewikkeld? Het gebruik van de geselecteerde waarden in de listbox is toch voldoende?