filteren en kopiëren

[broek76]

Goedemorgen,

In het bijgevoegde bestand is het de bedoeling dat elke naam(kolom A) met het cijfer 2(kolom B) er achter gekopieerd wordt naar blad 2.
ik gebruik hier een filter voor maar op het moment dat er geen 2 staat kopieert de macro alle namen, dat is natuurlijk niet de bedoeling.
Weet iemand hier iets op?

Mvg Ron

Bekijk bijlage filtertest.xlsm

 

[edmoor]

Doe het eens zo:

Sub filteren()
    On Error GoTo NietsZichtbaar
    ActiveSheet.ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=2
    Range("Tabel1[naam]").SpecialCells(xlCellTypeVisible).Select
    Selection.Copy Destination:=Sheets("Blad2").Cells(1, 1)

NietsZichtbaar:
    ActiveSheet.ListObjects("Tabel1").Range.AutoFilter Field:=2
    ActiveSheet.AutoFilterMode = False
End Sub

 

[snb]

Als niets wordt gefilterd wordt er ook niets gekopeerd (behalve de 'veldnamen').

Zie ook:
http://www.snb-vba.eu/VBA_Autofilter.html

 

[broek76]

Edmoor, hij werkt maar ik gebruik het in een groter bestand waar filterwaarde steeds anders is.
In de bijlage heb ik hem ietsje uitgebreid waardoor ik bij de volgende waarde een foutmelding krijg.

snb, waarom kopieert hij bij mij dan de hele kolom maar niet de veldnaam?
Mooie site die ik trouwens al regelmatig gebruik maar als beginner heb ik soms een beetje meer Jip en Janneke uitleg nodig.

 

[snb]

In de macromodule van Blad1:

Sub M_snb()
    With ListObjects(1).Range
      .AutoFilter 2, 1
      If .Columns(1).SpecialCells(12).Count > 1 Then .Offset(1).Copy Blad2.Cells(1)
      .AutoFilter
    End With
End Sub

 

[broek76]

snb, hij neemt nu ook kolom B mee. Moest eigenlijk alleen de namen zijn.

 

[broek76]

Heb het al gevonden, zo doet hij het:

Sub test()
    With ListObjects(1).Range
    .AutoFilter 2, 1
    If .Columns(1).SpecialCells(12).Count > 1 Then
    .Columns(1).Offset(1).Copy Blad2.Cells(1)
    End If
    .AutoFilter
    End With
End Sub

Allebei bedankt, ik kan hier mee verder.