Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 7 van 7

Onderwerp: Filter (vba) binnen een bereik

  1. #1
    Vraag is opgelost

    Filter (vba) binnen een bereik

    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") and ("<2000")
        With .Range("a1:P" & .Cells(Rows.Count, 1).End(xlUp).Row)
         .AutoFilter 1, arr
        .Copy .Parent.Parent.Sheets(Switch(arr = ">999"  and ("<2000"), "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

  2. #2
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    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 aangepast door HSV : 19 mei 2017 om 21:11
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  3. #3
    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.

  4. #4
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Ongetest,
    Code:
    .offset(1).Copy Sheets(2).Cells(application.max(3,sheets(2).cells(rows.count,1).end(xlup).row),1).offset(1)
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  5. #5
    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?

  6. #6
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Er mist een punt voor 'offset'.
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  7. #7
    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...

  8. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren
Aanbiedingen