Autofilter in VBA gebruiken

[lvisser]

ik ben bezig om uit een database bepaalde waarden te selecteren en die te plakken in een ander blad.
het lukt me met VBA wel om de selecties te maken, en om alle waarden te kopiëren, maar met een bepaalde selectie van kolommen gaat het fout.

zie het bestand.

de bedoeling is dat de kolommen C tot en met H naar het blad "PlanBlad" gaan en dan alleen de rijen waar voor geldt dat de kolom H "WAAR" is.

De output op Blad PlanBlad zou dan gesorteerd moeten worden op de kolom Afdeling en vervolgens op Straat...

wie helpt me verder ?

 

[globe]

Sub SelectieOpGeslacht()

With Worksheets("DATA").Range("C:H")

.AutoFilter 6, "WAAR"
Range("c:h").Select
Selection.Copy

   Sheets("PlanBlad").Select
   Set thisWb = ActiveWorkbook
   
     Range("A:F").Select
    ActiveSheet.Paste

End With

End Sub

 

[lvisser]

dank voor de snelle reactie, in het DATA blad blijft de selectie staan op WAAR? dat hoeft niet, omdat de waarden toch naar een ander blad gaan mag die selectie er na het kopieren af.

het sorteren op de 2 kolommen doe ik na het plakken:
.Sort key1:=.Columns(5), Order1:=xlAscending
.Sort key2:=.Columns(2), Order1:=xlAscending

dat geeft een foutmelding maar lijkt wel te werken ?

 

[globe]

Sub SelectieOpGeslacht()

With Worksheets("DATA").Range("C:H")

.AutoFilter 6, "WAAR"
Range("c:G").Select
Selection.Copy

   Sheets("PlanBlad").Select
   Set thisWb = ActiveWorkbook
   
     Range("A:F").Select
    ActiveSheet.Paste


Columns.Sort key1:=Columns("E"), Order1:=xlAscending, Key2:=Columns("B"), Order2:=xlAscending, Header:=xlYes

End With

End Sub

 

[JEC.]

Als je de headers alvast plaatst op tabblad2, kun je het zo doen.

Sub jec()
 Application.ScreenUpdating = False
 With Sheets("DATA").Cells(1, 1).CurrentRegion
   .AutoFilter 8, "WAAR"
   .Offset(1, 2).Resize(, 6).Copy
    With Sheets("PlanBlad").Cells(2, 1)
      .PasteSpecial xlPasteValues
      .CurrentRegion.Sort .Offset(, 5), 1, .Offset(, 1), , 1, , 1
    End With
   .AutoFilter
 End With
End Sub

 

[lvisser]

Als ik deze doe dan krijg ik FOUT 1004 tijden uitvoering, Methode AutoFilter van klasse Range is mislukt ?

 

[lvisser]

in het voorbeeldbestand gaat het prima, echter als ik een en ander in een andere Excel inbouw dan gaat het fout.
VBA struikelt dan op .AutoFilter 6, "WAAR"
met de melding FOUT 1004 tijdens uitvoering: Methode AutoFilter van klasse Range is mislukt.

ik wil van een groot blad de kolommen BA:BF selecteren, op kolom BF de autofilter en het resultaat kopiëren naar blad PlanBlad.
Wat doe ik fout ?

Sub SelectieOpGeslacht()

With Worksheets("DATA").Range("C:H")

.AutoFilter 6, "WAAR"
Range("c:G").Select
Selection.Copy

   Sheets("PlanBlad").Select
   Set thisWb = ActiveWorkbook
   
     Range("A:F").Select
    ActiveSheet.Paste


Columns.Sort key1:=Columns("E"), Order1:=xlAscending, Key2:=Columns("B"), Order2:=xlAscending, Header:=xlYes

End With

End Sub

 

[globe]

Sub SelectieOpGeslacht()

With Worksheets("DATA").Range("C:H")   'Wijzig deze in (BA:BF)

.AutoFilter 6, "WAAR"  
Range("c:G").Select 'Wijzig in welke kolommen je wilt kopieren
Selection.Copy

   Sheets("PlanBlad").Select
   Set thisWb = ActiveWorkbook
   
     Range("A:F").Select 'Wijzig waar je ze heen wil hebben
    ActiveSheet.Paste


Columns.Sort key1:=Columns("E"), Order1:=xlAscending, Key2:=Columns("B"), Order2:=xlAscending, Header:=xlYes 'Wijzig kolommen waar je op wil sorteren

End With

End Sub

]

Check even mijn comments in de code en voer de macro stap voor stap uit (F8 in VBA editor) dan zie je exact wat re gebeurd.

Of stuur een voorbeeld van je file, bv 3 regel zonder gevoelige info

je code zou dan zo moeten werken:

Sub SelectieOpGeslacht()

With Worksheets("DATA").Range("BA:BF")

.AutoFilter 6, "WAAR"
Range("BA:BE").Select
Selection.Copy

   Sheets("PlanBlad").Select
   Set thisWb = ActiveWorkbook
   
     Range("A:F").Select
    ActiveSheet.Paste


Columns.Sort key1:=Columns("E"), Order1:=xlAscending, Key2:=Columns("B"), Order2:=xlAscending, Header:=xlYes

End With

End Sub

 

[lvisser]

ik heb m al ... in het uiteindelijke blad waar ik in werk was de range BA:BF niet autofilter ...
die staat er nu op en het werkt prima !!

 

[JEC.]

Als ik deze doe dan krijg ik FOUT 1004 tijden uitvoering, Methode AutoFilter van klasse Range is mislukt ?

Als je eerst de autofilter even verwijdert voordat je hem runt, gaat het goed.
"Selects" zijn niet nodig en maken de code traag.

 

[lvisser]

deze methode is inderdaad sneller ...
ik probeer de methode met offset te snappen, maar met veel voorbeelden op internet kom in niet veel verder.

stel dat ik de onderstaande met offset wil doen, hoe zou dat dan gaan ?

Sheets("DATA").Select
Columns("AF:AG").Select
Selection.ClearContents

 

[JEC.]

Hiervoor is geen offset nodig, net als de selects

Sheets("DATA").Columns("AF:AG").ClearContents

 

[lvisser]

ik kom er toch niet helemaal uit .... met het voorbeeld gaat het goed, maar als ik dan wat anders wil, gaat het niet goed.

in blad data heb ik een range met data, uit die data maak ik 2 selecties met een macro, kolom L en M is de ene set data, en de 2e is W : Y.
Om dit te bewerkstellingen kopieer ik de data, plak die als waarden en haal er de unieke waarden uit.
die unieke waarden wil ik dus een selectie op doen, en neerzetten in PLanBlad, nu komt er data op blad PlanBlad, maar dat is niet wat ik zou willen. kun je misschien wat comments bij de code zetten bij de kolommen etc.?
het is de bedoeling dat de 1e set gesorteerd wordt op de klom A, en de 2e set eerst op kolom E en daarna op D...
het bestandje in de bijlage...

 

[lvisser]

Als je eerst de autofilter even verwijdert voordat je hem runt, gaat het goed.
"Selects" zijn niet nodig en maken de code traag.

ik loop toch vast als ik 2 ranges wil verwerken.
de eerste range gaat prima, de 2e range ook, juiste colommen worden geselecteerd, maar als hij dan het autofilter moet doen .AutoFilter 3, "WAAR" dan selecteert hij de al eerder geselecteerde kolommen ( range AF:AG)..
wat gaat er fout ?




Sub VerwerkenData()
'
' Verwijderen DATA verschillende bladenvan tabblad DATA
'


' data verwijderen


Sheets("DATA").Columns("AF:AG").ClearContents
Sheets("PlanBladIn").Range("A2:A999").ClearContents
Sheets("DATA").Columns("AO:Aq").ClearContents
Sheets("DATA").Columns("AS:AU").ClearContents

'Ritten IN unieke ritten
Sheets("Data").Select
Range("AA:AB").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Range("AA:AB").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range _
("AF1"), Unique:=True

Columns("AF:AG").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF1").Select


'Plaatsen in Blad PlanBladIn
Application.ScreenUpdating = False
With Sheets("DATA").Cells(1, 31).CurrentRegion
.AutoFilter 3, "WAAR" ' kolom waar op geselecteerd wordt
.Offset(1, 1).Resize(, 1).Copy
With Sheets("PlanBladIn").Cells(2, 1)
.PasteSpecial xlPasteValues
.CurrentRegion.Sort Key1:=.Range("A1"), Header:=xlYes
' .CurrentRegion.Sort .Offset(, 1), 1
End With
.AutoFilter
End With

'Ritten UIT unieke ritten
Sheets("Data").Select
Columns("AI:AK").Select
Selection.Copy
Range("AO1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AO:AQ").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Range("AO1:AQ3049").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range _
("AS1"), Unique:=True

Range("As1").Select

'Plaatsen in Blad PlanBladUit


Application.ScreenUpdating = False
With Sheets("DATA").Cells(1, 45).CurrentRegion
.AutoFilter 3, "WAAR" ' kolom waar op geselecteerd wordt
.Offset(1, 1).Resize(, 2).Copy
With Sheets("PlanBladUit").Cells(2, 1)
.PasteSpecial xlPasteValues
.CurrentRegion.Sort Key1:=.Range("A1"), Header:=xlYes
' .CurrentRegion.Sort .Offset(, 1), 1
End With
.AutoFilter
End With