Copy Filter

[HarryBee]

Beste experts,

Ik gebruik de volgende code om vanuit een databaseblad de met een autofilter verkregen info, te kopieren naar een ander tabblad genaamd Overzichtje. Alleen doet het feit zich voor dat in het overzichtje het bovenste deel het gefilterde deel is en daaronder gewoon de rest van het databaseblad te zien is. Dit moet dus niet. Wellicht staat er iets fout in de code of is deze niet compleet. Kan iemand mij daarbij helpen.

Sub CopyFilter()

ActiveSheet.Unprotect Password:="01"
Dim rng As Range
Dim rng2 As Range

With Worksheets("Database").AutoFilter.Range
 On Error Resume Next
   Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
End With
If rng2 Is Nothing Then
   MsgBox "Het datagebied is leeg. Kopiëren niet mogelijk"
Else
   Worksheets("Overzichtje").Range("A5").Cells.Clear
   Set rng = Worksheets("Database").AutoFilter.Range
   rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
        Destination:=Worksheets("Overzichtje").Range("A5")
        'Destination.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     
End If
   'ActiveSheet.ShowAllData
ActiveSheet.Protect Password:="01", AllowFormattingCells:=True, UserInterfaceonly:=True, AllowFiltering:=True
    Range("A5").Select
End Sub

Mijn dank is groot.

Groeten Harry

 

[DCWDPT]

Harry,

Misschien is een bestandje (zonder gevoelige info) plaatsen verstandig. Al 18 mensen hebben gekeken en jouw vraag niet opgepakt. Met bestand heb je meer kans.

 

[HarryBee]

opgelost

Bedankt voor het meedenken. Het is opgelost.

Groeten Harry

 

[Gert Bouwmeeste]

Bedankt voor het meedenken. Het is opgelost.

Groeten Harry

Hoe dan? Lege regel in het te filteren bestand of zo?

 

[HarryBee]

Hoe dan? Lege regel in het te filteren bestand of zo?

Gert,

Het is misschien wat simpel maar ik heb mijn probleem opgelost met het volgende:

Sub CopyFilter3()
'
Worksheets("Overzicht").Range("B5:DL5002").Cells.Clear
Application.ScreenUpdating = False

    Sheets("Database").Select
        Range("B3:DL5002").Select
        Selection.AutoFilter Field:=103, Criteria1:="B"
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        
    Sheets("Overzicht").Select
        Range("B5").Select
        Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
            
    Sheets("Database").Select
        Selection.AutoFilter Field:=103
        Range("B3").Select

    Sheets("Overzicht").Select
        Range("B5").Select

Application.ScreenUpdating = True
End Sub

Groeten Harry

 

[snb]

Vermijd select en activate in VBA (dan is screenupdating =false meestal ook overbodig).
Dit was voldoende geweest:

Sub CopyFilter3()
  Worksheets("Overzicht").Cells.Clear
  With [Database!B3:DL5002]
    .AutoFilter 103, "B"
    .SpecialCells(xlCellTypeVisible).copy [Overzicht!B5]
    .Autofilter
  End With
End Sub

 

[HarryBee]

Vermijd select en activate in VBA (dan is screenupdating =false meestal ook overbodig).
Dit was voldoende geweest:

Sub CopyFilter3()
  Worksheets("Overzicht").Cells.Clear
  With [Database!B3:DL5002]
    .AutoFilter 103, "B"
    .SpecialCells(xlCellTypeVisible).copy [Overzicht!B5]
    .Autofilter
  End With
End Sub

Snb,

Ook dit werkt inderdaad veel beter. :thumb: Een vraagje nog: Hoe kan ik nu een 2e argument verwerken.Want dat lukt met niet.

Sub CopyFilter3()

Dim wn As Range
Set wn = Worksheets("Overzicht").Range("$D$3")
  Worksheets("Overzicht").Range("B7:AC5002").Cells.Clear
  With [Database!B3:AC5002]
    .AutoFilter 21, wn 
    .AutoFilter 24, wn 
    .SpecialCells(xlCellTypeVisible).copy [Overzicht!B6]
    .Autofilter
  End With
End Sub

[/QUOTE]

Het is dus de bedoeling als kolom 21 OF 24 voldoet aan de voorwaarde, dat deze wordt teruggegeven in het overzicht.

Alvast mijn dank

Groeten Harry

 

[snb]

Sub CopyFilter3()
  With [Database!B3:AC5002]
    .AutoFilter 21, [Overzicht!$D$3],xlor, 24 ,[Overzicht!$D$3]
    .SpecialCells(12).copy [Overzicht!B6]
    .Autofilter
  End With
  [Overzicht!B7:AC5002].Cells.Clear
End Sub

PS vermijd overbodige variabelen (en dito declaraties)

 

[HarryBee]

Sub CopyFilter3()
  With [Database!B3:AC5002]
    .AutoFilter 21, [Overzicht!$D$3],xlor, 24 ,[Overzicht!$D$3]
    .SpecialCells(12).copy [Overzicht!B6]
    .Autofilter
  End With
  [Overzicht!B7:AC5002].Cells.Clear
End Sub

PS vermijd overbodige variabelen (en dito declaraties)

Snb,

Dit is precies wat ik wilde weten. :thumb: Dank je wel voor je hulp.

Groeten Harry