• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Gegevens wegschrijven naar verschillende tabbladen

Status
Niet open voor verdere reacties.
Beste snb,

Eens gezocht op het net en volgende gevonden maar werkt niet ??
Volgende code gevonden:

Code:
Sheet2.Range("D4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
 CriteriaRange:=Sheet1.Range("M5:N6"), CopyToRange:=Sheet1.Range("C8:K8"), Unique:=False

In cel Z1 staat Omschr. operatie, in cel Z2 staat ZB
In cel AA1 staat Korte tekst, in cel AA2 staat AA

Aangepaste code voor mijn bestandje:

Code:
Sub ZBAA()
    i = "ZBAA"
    Sheets("output").Cells(1).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
 CriteriaRange:=Sheets(i).Range("Z1:AA2"), CopyToRange:=Sheets(i).Cells(1)
    Sheets(i).Columns.AutoFit
End Sub
 
Beste snb,

Heb het bereik U1:U2, omschrZB benoemd en bereik W1:W2 tekstAA benoemd
Z1= omschrZB, AA1=tekstAA

Code:

Code:
Sub ZBAA()
    i = "ZBAA"
 Sheets("output").Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, Range("Z1:AA1").CurrentRegion, Sheets(i).Cells(1)
    Sheets(i).Columns.AutoFit
End Sub

...werkt niet ??
 
Beste snb,

Kan je nog eens een tip geven of een site waar ik kan zoeken
Moet het woord validation in de code komen ?
Ik zit sloot en weet niet wat of waar zoeken
 
Beste snb,

nog eentje die het niet doet ?

Code:
Sub ZBAA()
    i = "ZBAA"
 Sheets("output").Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, Range("Kortetekst"), CopyToRange:=Sheets(i).Cells(1)
    Sheets(i).Columns.AutoFit
End Sub

Kortetekst is bereik Z1:Z2 met daarin Kortetekst en AA
 
Je doet een 'FilterInPlace' Danny.
 
Danny,

Je doet een xlfiltercopy met:
Code:
 Sheets("output").Cells(1).CurrentRegion.AdvancedFilter [COLOR=#ff0000]xlfiltercopy[/COLOR], Range("Kortetekst"), CopyToRange:=Sheets(i).Cells(1)

En een xlfilterinplace met:
Code:
 Sheets("output").Cells(1).CurrentRegion.AdvancedFilter [COLOR=#ff0000]xlFilterInPlace[/COLOR], Range("Kortetekst")
 
Beste snb,

Lukt mij niet
Wat ik eigenlijk wil is de volgende codes vereenvoudigd zien en gemakkelijk kunnen aanpassen via een lijst en niet telkens naar de code te moeten gaan om gegevens te wijzigen

Code:
Sub MBZB()
Dim mySheetName As String
Dim str As String
    Sheets("MBZB").Activate
     str = ActiveSheet.Name
        With ThisWorkbook.Sheets("Output")
         With .Cells(2).CurrentRegion
          If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
         .AutoFilter 11, Criteria1:="*MB - ZB*", Criteria2:="<>*TK*"
         .AutoFilter 10, Criteria1:="<>*AA", Criteria2:="*Alg.*"
         Worksheets(str).Cells.ClearContents
          .Cells(2).CurrentRegion.Copy Destination:=Worksheets(str).Range("A1")
          Worksheets(str).Columns.AutoFit
          Range("A2:P4000").Sort Key1:=Range("H2"), Order1:=xlAscending
          Sheets("output").ShowAllData
         End With
        End With
End Sub

Code:
Sub MTB()
Dim mySheetName As String
Dim str As String
    Sheets("MTB Orders").Activate
     str = ActiveSheet.Name
        With ThisWorkbook.Sheets("Output")
         With .Cells(2).CurrentRegion
         If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
         .AutoFilter Field:=8, Criteria1:=Array( _
            "GA   MTB", "GA   MTB  PNR", "GG   MTB  PNR", "GP", "GP   CNC  PNR", "GP   DTRU", _
            "GP   MTB", "GP   MTB  DTRU", "GP   MTB  LLO", "GP   MTB  PNR", _
            "GP   MTB  PNR  DTRU", "GP   PNR", "GP   PNR  DTRU", "VB   MTB", "VB   MTB  DTRU", _
            "VB   MTB  PNR", "VB   MTB  PNR  DTRU"), Operator:=xlFilterValues
        Worksheets(str).Cells.ClearContents
        .Cells(2).CurrentRegion.Copy Destination:=Worksheets(str).Range("A1")
        Worksheets(str).Columns.AutoFit
        Range("A2:P2000").Sort Key1:=Range("J2"), Order1:=xlAscending
        End With
        End With
End Sub

Lukt dit niet dan hou ik dit zoals het is
 
@danny

Dit is een forum en geen privé communicatiekanaal.
Vragen richt je aan het forum en niet slechts aan een persoon.
Iedereen kan op je vragen reageren.
 
Wel frappant Danny,

Als @snb reageert schrijf je 'beste HSV'.
Als ik een reactie plaats schrijf je 'beste snb'.

Als dat al niet goed binnenkomt, ....... :rolleyes:
 
Sorry HSV

Omdat ik eigenlijk reactie krijg van snb wordt dit een beetje een gewoonte, vandaar :eek:
 
Plaats eens een voorbeeld-bestandje met wat je nu doet en hoe je het graag zou willen hebben.
De criteria wil je eigenlijk in cellen plaatsen, en met advancedfilter oplossen?
 
Beste,

In bijlage het voorbeeldbestandje

Sub ZBAA() werkt naar behoren
Sub Hijskabels(), deze werkt niet omdat hij naar het bereik "Z1:AB3" moet kijken (geeft geen meerdere filters weer)
Sub MTB(), deze doet het ook niet omdat het bereik "Z1:Z7" waarschijnlijk te veel filters

Elk bereik staat op het tabblad waar de info moet komen
 

Bijlagen

  • Test gegevens.xlsm
    68 KB · Weergaven: 39
Sub Hijskabels(),
Voer AA2 eens door naar AA3 en AB2 naar AB3, en zet in de code Z1:AB3

Sub MTB() werkt prima, zet maar eens een filter in Output zoals in Z1:Z7.
Daarna tel ik met =subtotaal(3,O2:O155) 81 rijen.
Na de xlfiltercopy staan er ook 81 rijen.
 
Laatst bewerkt:
Beste HSV,

Nu lukt het allemaal ineens
Wist niet dat je alles moest opvullen in het bereik
Gaat nu ook wanneer ik er een validatielijst aan koppelt
En via deze formule ze ook dynamischer maak

Code:
=VERSCHUIVING(MTB!$Z$1;0;0;AANTALARG(MTB!$Z:$Z))

Bedankt aan Cobbe, VenA, snb en HSV :thumb: :thumb: ;)
 
Beste,

Gezien bij Hijskabels dat hij alles weergeeft wat verv en kabel bevat
Wil eigenlijk zien dat hij bevat en bevat weergeeft, dus (en en), en niet (en of)
Hoe geef je dat in het bereik Z1:AA3 weer ?
De rood gekleurde wil ik dus niet zien

LK138 HY Verv. takelblok+ kabel
LK143-HY HW : kabelgeleider smeren.
LK146 HY1 Afregelen hijskabels OPL
LK231 HY1 Verv. kabels + takelblok.
LK436-Kabelkat: kunststof geleidingswiel
LK445-POS : Verv. haak
LK361 HY1 MB AB Vervangen kabels
 
Korte tekstOmschr. operatieWerkplek
*verv***kabel**hijs*RM

Let op de extra jokerteken (hier in het rood).

Criteriarange: = Z1:AB2
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan