Deelnemerslijst per activiteit in betreffende tab/sheet plaatsen

[webwoody]

Elk kwartaal wordt de deelname aan een activiteit in het programma PC-leden geactualiseerd. Uit dat programma kan ik dan een excellijst halen met daarin alle deelnemers (ongeveer 450) van al die activiteiten (30 categorieën) om voor elke Categorie een kwartaal lijst te maken.
Elke groep heeft een Tab/sheet binnen het bestand met daarop specifieke informatie van die Categorie. De bedoeling is nu om op elke Tab van betreffende Categorie onder de genoemde informatie een actuele deelnemerslijst te plakken.

Heb dit proberen te automatiseren door nadat ik de lijst van betreffende Categorie via Filter (door 1 Categorie te kiezen) op het scherm heb staan met een macro te kopiëren, naar betreffende tab te gaan en aldaar te plakken. Maar dit betekent dus dat ik steeds (30x dus) de voorbereiding van het filteren moet doen en dan de betreffende macro (heb er dus 30 gemaakt om elke tab te vullen) kan draaien om betreffende tab te vullen
Is er een wijze om de verdeling over de 30 tabs makkelijker/sneller te doen? Of moet ik een heel lange macro gaan opnemen?

Bijgevoegd heb ik even een lege Deelnemerslijst (moet privacy in acht nemen) gevoegd waarin de kolom Categorie is te zien waarop ik eerst filter om daarna betreffende Categorie apart met een macro naar betreffende tab te kopiëren. De Tabs/sheets hebben dezelfde naam als betreffende categorie (enkele blanco voorbeelden ingevoegd)

 

[gast0660]

Hoi,
Je hebt een vraag over macro's maar je stuurt een xlsx file door
Eerst maar eens het juiste voorbeeldje doorsturen.
Greetz

 

[webwoody]

Hallo,
De macro's die ik nu gebruik heb ik beschreven en zijn niet relevant denk ik omdat die doen wat ik ervan verwacht. Echter is er plat gekeken naar de deelnemerslijst die ik bijgevoegd heb geen snellere/minder intensieve methode om omschreven handelingen in één keer uit te voeren ipv 30x ?

 

[Leotaxi]

probeer deze eens

Sub Macro2()
Dim sh As String
With ActiveSheet
    lr = Range("A" & Rows.Count).End(xlUp).Row
    r = Application.Match("Categorie", .Range("A:A"), 0)
    .Range("Z1").Resize(lr - r, 1).Value = Range("A" & r + 1, "A" & lr).Value
    ActiveSheet.Range("$Z:$Z").RemoveDuplicates Columns:=1, Header:=xlNo
    lr2 = Range("Z" & Rows.Count).End(xlUp).Row
    For x = 1 To lr2
        Range("A" & r, "I" & r).AutoFilter
        sh = Range("Z" & x).Value
        ActiveSheet.Range("$A" & r, "I" & lr).AutoFilter Field:=1, Criteria1:=sh
        Sheets(Range("Z" & x).Value).Range("A1").Resize(1, 9).Value = Sheets("PCLdata").Range("A" & r, "I" & r).Value
        With Sheets("PCLdata").Range("A" & r).CurrentRegion
            .Offset(1).Copy Sheets(sh).Range("A" & Rows.Count).End(xlUp).Offset(1)
        End With
    Next
    .Range("Z:Z").ClearContents
End With
End Sub

mvg
Leo

 

[webwoody]

Dag Leo,

Dank voor je reactie

Heb de code in de sheet gezet waarin het moet gebeuren en krijg de melding

Fout 9 tijdens uitvoering:
Het subscript valt buiten bereik

Dan kleurt in Visual Basic onderstaande regel geel

Sheets(Range("Z" & x).Value).Range("A1").Resize(1, 9).Value = Sheets("PCLdata").Range("A" & r, "I" & r).Value

Ter info: in het originele bestand vindt op PCLdata de selectie plaats vanaf B12 t/m I12 Naar beneden toe. In alle categorie tabs plak ik op B12 (naar rechts en beneden). Weet niet of je hier iets mee kunt

 

[VenA]

Zal een filter niet voldoende zijn?

Sub VenA()
For Each sh In Sheets
    If Not sh.Name = "PCLdata" Then
        sh.Cells.Delete
        With Sheets("PCLdata")
            .Cells(4, 1).CurrentRegion.AutoFilter Field:=1, Criteria1:=sh.Name
            .UsedRange.Cells.Copy sh.[A1]
        End With
    End If
Next sh
End Sub

 

[webwoody]

In het voorbeeldbestand lijkt het te werken maar in het originele bestand wordt het een puinhoop. In alle sheets wordt er van alles uit PCLdata mee gekopieerd.
Zoals in een eerdere reactie aangegeven in het originele bestand vindt op PCLdata de selectie plaats vanaf B12 t/m I12 Naar beneden toe. In alle categorie tabs plak ik op B12 (naar rechts en beneden). Weet niet of je hier iets mee kunt

 

[Leotaxi]

Een filter is inderdaad voldoende
en als het in voorbeelbestand werkt en in een ander bestand een puinhoop wordt
dan ligt het aan dat andere bestand.

mvg
Leo

 

[mvw64]

Misschien kan je er zo iets mee ?
Eerst worden de tabbladen aangemaakt dan ingevuld

 

[webwoody]

mvw64. Het werkt geweldig maar zoals in een eerdere reactie aangegeven in het originele bestand vindt op PCLdata de selectie plaats vanaf B12 t/m I12 Naar beneden toe. In alle categorie tabs plak ik op B12 (naar rechts en beneden).

Dus de tabbladen bestaan al met daarop boven B12 specifieke informatie per activiteit die moet blijven staan. daaronder komt dan elk kwartaal een geactualiseerde deelnemers lijst

 

[VenA]

Ik zou deze eens aanpassen

.Cells(4, 1).CurrentRegion

Vanaf welke rij gebeurt er iets in het voorbeeldbestand en vanaf welke rij moet het gebeuren?

Als je schrijft dat het in het originele bestand een puinhoop wordt, plaats dan even de correcte layout van dat bestand.

 

[webwoody]

Elke activiteitentab ziet er boven regel 12 met verschillende date als bijgevoegd voorbeeld uit. Vanaf PCLdata moet de deelnemersdata er vanaf B12 in gezet worden. In principe hoeft de eerste kolom (Categorie) niet meegenomen worden

 

[VenA]

We komen alweer een stap verder het gaat blijkbaar om waar de gegevens weggeschreven moeten worden. Hoe moet excel weten dat de categorie 'Schildmo' weggeschreven moet worden in waarschijnlijk de tab 'Schilder-Mmo'? Zorg er eerst voor dat elke tab exact dezelfde naam heeft als de naam die je gebruikt als categorie.

Haal vervolgens alle niet relevante zaken uit de tab 'PCLdata' zodat je alleen een tabel overhoudt, met de daarin relevante zaken.

Sub VenA()
For Each sh In Sheets
    If Not sh.Name = "PCLdata" Then
        With Sheets("PCLdata")
            .Cells(1).CurrentRegion.AutoFilter Field:=1, Criteria1:=sh.Name
            .UsedRange.Cells.Offset(, 1).Copy sh.[B12]
        End With
    End If
Next sh
End Sub

Even een combinatie gemaakt van jouw testbestand en het halve origineel.

 

[webwoody]

Hallo VenA

Het ziet er al heel goed uit. Ben met je eens dat het wat naamgeving een allegaartje is bij de Tab-namen maar toen ik bij de club binnenkwam was het leed al geleden en als je het wat wil automatiseren (geloof het of niet maar alles wat uit PCleden kwam werd netjes in de excel lijsten getikt) moet het inderdaad wel eenduidig zijn.
Moet nu dus even aan de slag om de tab namen gelijk aan Categorie namen te maken. Ook uit PCLdata moet ik wat overzetten naar een andere sheet zodat die schoon ingezet kan worden.

Dit duurt dus even maar ik zal me weer melden als ik zover ben of het werkt of als er nog iets is. Dank alvast voor je inzet!!

 

[webwoody]

Dag VenA,

Heb de tabs allemaal exact dezelfde naam als de betreffende categorie gegeven en PCLdata opgeruimd op de tabel na met als resultaat dat HET WERKT ZOALS GEWENST op 1 dingetje na. Als er het vorige kwartaal bij een activiteit er 20 deelnemers waren en in het nieuwe kwartaal bijvoorbeeld 15 dan plakt hij keurig die 15 op de gewenste positie maar blijven de 5 rijen van het vorige kwartaal staan. Is er een manier om aan te geven dat hij het gebied eerst wist en dan de nieuwe lijst plakt?
Als laatste de vraag of er in de eerste kolom een volgnummer (1 t/m het aantal deelnemers) geschreven kan worden zodat er snel het aantal in beeld is. Of draaf ik nu door?
In ieder geval ben ik nu al erg tevreden, waarvoor dank!!

 

[VenA]

Je kan in Excel macro's opnemen waarmee je beide vragen had kunnen oplossen en de code hier kunnen plaatsen ter verbetering of bij een onjuiste werking

Om de vorige gegevens te wissen:

sh.[B12].CurrentRegion.Offset(1).Clear

Om een volgnummer te maken bv zo:

For j = 1 To sh.[B12].CurrentRegion.Rows.Count - 2
     sh.Cells(j + 12, 1) = j
Next j

Mag je zelf even inpassen in de vorige code.

 

[HSV]

Of volgnummer.

 sh.[A13].Resize(sh.[b13].CurrentRegion.Rows.Count - 2) = [Row(1:10000)]