Filter (vba) binnen een bereik

Status
Niet open voor verdere reacties.

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
901
Beste Helpmij'ers,

Ik heb hier een bestaande code gevonden (HSV) die mijn wens redelijk benaderd.

Het is de bedoeling dat het systeem moet filteren tussen 999 en 2000 (dat laatste werkt niet) en dat vervolgens de selectie naar een volgend tabblad gekopieerd dient te worden. Bij het kopiëren gaat nu ook de bovenste regel mee, het is de bedoeling dat alleen hetgeen gefilterd is mee gaat naar het volgende tabblad.

De code is:
Code:
Sub hsv()
Dim arr
Application.ScreenUpdating = False
With ThisWorkbook
  With .Sheets("blad1")
  For Each arr In Array(">999")[B] and ("<2000")[/B]
    With .Range("a1:P" & .Cells(Rows.Count, 1).End(xlUp).Row)
     .AutoFilter 1, arr
    .Copy .Parent.Parent.Sheets(Switch(arr = ">999" [B] and ("<2000")[/B], "Gas")).Range("A" & Rows.Count).End(xlUp).Offset(2)
     .AutoFilter
    End With
  Next arr
 End With
End With
End Sub

Een reactie zie ik met veel belangstelling tegemoet.

Robert
 
Die code heb ik vast niet zo geschreven.
Code:
Sub hsv()
  With Sheets("blad1")
   With .Range("a1:P" & .Cells(Rows.Count, 1).End(xlUp).Row)
     .AutoFilter 1, ">999", 1, "<2000"
     .offset(1).Copy Sheets(2).Cells(rows.count,1).end(xlup).offset(1)
     .AutoFilter
    End With
 End With
End Sub
 
Laatst bewerkt:
Heel erg bedankt, dit is precies wat ik bedoelde. De code heb ik idd wat gewijzigd.

Ik heb nog een vraag hoe ik de data op vanaf bijvoorbeeld regel 4 kan plaatsen. Volgens mij kun je dan niet met .Offset(1) werken omdat dan altijd gekeken wordt naar de eerst volgende lege regel. Mijn bedoeling is, ongeachte wat er boven en onder gebeurd, dat de data geplakt wordt op regel 4 en de daarop volgende regels.
 
Ongetest,
Code:
.offset(1).Copy Sheets(2).Cells(application.max(3,sheets(2).cells(rows.count,1).end(xlup).row),1).offset(1)
 
Na enig experimenteerwerk heb ik de oplossing gevonden en weet ik nu hoe je de gegeven kopieert naar een bepaalde omgeving. Nu dacht ik dat ik de code eenvoudig kon uitbreiden t.b.v. meerdere selecties, echter was dat te eenvoudig gedacht.

Code:
Sub hsv()
With Sheets("blad1")
   With .Range("a1:P" & .Cells(Rows.Count, 1).End(xlUp).Row)
     .AutoFilter 1, ">999", 1, "<2000"
     .Offset(1).Copy Sheets("Gas").Cells(Rows.Count, 1).End(xlUp).Range("A4")
     .AutoFilter 1, ">2999", 1, "<4000"
     Offset(1).Copy Sheets("Gas").Cells(Rows.Count, 1).End(xlUp).Range("A10")
     .AutoFilter
    End With
 End With
End Sub

Ik krijg nu de foutmelding: Sub of Function is niet gedefineerd. Wat moet ik nog doen zodat ik op meerdere filters kan kopiëren?
 
Er mist een punt voor 'offset'.
 
Heel erg bedankt, je kijkt er zo lang na dat je over je eigen fout heen kijkt.

Uiteindelijk is het er zo uit gaan zien en werkt perfect.

Code:
Sub hsv()
With Sheets("blad1")
   With .Range("a1:P" & .Cells(Rows.Count, 1).End(xlUp).Row)
     .AutoFilter 1, ">999", 1, "<2000"
     .Offset(1).Copy Sheets("Gas").Range("A2")
     .AutoFilter 1, ">1999", 1, "<3000"
     .Offset(1).Copy Sheets("Gas").Range("A8")
     .AutoFilter 1, ">2999", 1, "<4000"
     .Offset(1).Copy Sheets("Gas").Range("A12")
     .AutoFilter
    End With
 End With
End Sub

Nogmaal super bedankt en zonder jouw hulp was het mij nooit gelukt...
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan