Excel: 1 tabblad splitsen over meerdere tabbladen

[yorroy]

Mijn vraag
Uit een managementtool komt een Excel bestand maar daarin 1 tabblad. In dat tabblad zitten ongeveer 20 kolommen en zo'n 1000 rijen.
In 1 van de kolommen wordt een categorie aangegeven middels 1,2,3,4,5 en A,B,C,D.

Elke week moet er een rapportage komen waarin elke categorie een eigen tabblad moet krijgen. Kan ik dit op de een of andere manier automatiseren middels een simpele functie of macro?
Nu ben ik elke week meer dan een uur bezig alles te categoriseren..

Relevante software en hardware die ik gebruik
Excel 2013

Wat ik al gevonden of geprobeerd heb
Geprobeerd een Marco op te nemen, maar dit lijkt niet goed te werken.

[ Voor 5% gewijzigd door yorroy op 19-10-2017 12:56 ]

[breew]

Lastig om te adviseren zonder een voorbeeld-bestand, maar kan die niet met een draaitabel + slicer?

Waarom zou je allemaal verschillende tabbladen gaan maken?

[ Voor 22% gewijzigd door breew op 19-10-2017 13:06 ]

[heuveltje]

klinkt verdacht veel als : Excel: waardes uit een cel verplaatsen naar data

Maar waar loop je tegenaan als je dit als macro wilt doen ?

[ Voor 22% gewijzigd door heuveltje op 19-10-2017 13:10 ]

[breew]

heuveltje schreef op donderdag 19 oktober 2017 @ 13:08:
klinkt verdacht veel als : Excel: waardes uit een cel verplaatsen naar data

Maar waar loop je tegenaan als je dit als macro wilt doen ?

Ik denk dat ik dat wel weet
Blijkbaar gebruikt @yorroy de macro-opnemer. Die maakt weliswaar een macro, maar de code is niet dynamisch. Als je de week daarop dan data hebt die iets langer/breder van formaat is, dan werkt je opgenomen code niet (goed).

Het wordt dus: Of zelf een macro schrijven, of zoeken naar andere oplossingen.

Ikzelf acht een draaitabel/draaigrafiek nog steeds kansrijk, maar zonder nadere informatie over de data, en voor wie de rapportage bedoeld is, kan ik daar natuurlijk niets over zeggen. Het is dus even wachten op nadere input van TS.

[CappieL]

Een opgenomen macro is niet dynamisch, maar die kun je naderhand altijd nog aanpassen.
Ik heb (vroeger) heel vaak macro's opgenomen (puur omdat ik de precieze code niet wist) en dan alle "statische" elementen vervangen door (zelf ingeklopte) dynamische elementen.

[breew]

CappieL schreef op donderdag 19 oktober 2017 @ 13:42:
Een opgenomen macro is niet dynamisch, maar die kun je naderhand altijd nog aanpassen.
Ik heb (vroeger) heel vaak macro's opgenomen (puur omdat ik de precieze code niet wist) en dan alle "statische" elementen vervangen door (zelf ingeklopte) dynamische elementen.

eens, het is een prima manier om te leren je eerste macro te schrijven...

[japie06]

Ik gebruik deze code om een sheet te splitten en twee sheets gebaseerd op een waarde in kolom E

code:

Sub split_sheet()

'naam van doel sheet   
    Sheets("Bron_sheet").Select 
    ' Find the last row of data
    FinalRow = Cells(Rows.count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow

        ' Decide if to copy based on column E (hier dus 5 want E is 5e kolom)
        ThisValue = Cells(x, 5).Value

'vul bij categorie1  de waarde in 
        If ThisValue = "Categorie1" Then 
            Cells(x, 1).Resize(1, 33).Copy

'naam van doel sheet
            Sheets("Target_sheet_1").Select

            NextRow = Cells(Rows.count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste

'naam van bron sheet
            Sheets("Bron_sheet").Select

'vul bij categorie2 de volgende waarde in
        ElseIf ThisValue = "Categorie2" Then
            Cells(x, 1).Resize(1, 33).Copy

'naam van 2 doelsheet
            Sheets("Doel_sheet_2").Select

            NextRow = Cells(Rows.count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste

'naam van bron sheet
            Sheets("Bron_sheet").Select
        End If
    Next x
 End Sub

Als je hem verder wilt uitbreiden kun je denk meer van die Elseif statements toevoegen.

[heuveltje]

breew schreef op donderdag 19 oktober 2017 @ 13:36:
[...]


Ik denk dat ik dat wel weet
Blijkbaar gebruikt @yorroy de macro-opnemer. Die maakt weliswaar een macro, maar de code is niet dynamisch. Als je de week daarop dan data hebt die iets langer/breder van formaat is, dan werkt je opgenomen code niet (goed).

Het wordt dus: Of zelf een macro schrijven, of zoeken naar andere oplossingen.

Ikzelf acht een draaitabel/draaigrafiek nog steeds kansrijk, maar zonder nadere informatie over de data, en voor wie de rapportage bedoeld is, kan ik daar natuurlijk niets over zeggen. Het is dus even wachten op nadere input van TS.

Ik gebruik dit zo vaak voor snelle macro's te maken.
gebruik de macro recorder. Selecteer 123 regels. en sla de macro op.
Bewerk die daarna, vervang 123 door 64000. loop nog een keer snel door de code heen of je ergens iets range achtig ziet wat niet klopt. en klaar is kees

Beetje vieze methode, maar heel handig voor van die simpele scriptjes waar ik anders toch snel een uur aan zou besteden ipv die 3 menuten die het nu kost


Overigens doe ik dit soort dingen altijd met een Filter > cut> paste in tabblad optie

[ Voor 3% gewijzigd door heuveltje op 19-10-2017 14:01 ]

[yorroy]

breew schreef op donderdag 19 oktober 2017 @ 13:04:
Lastig om te adviseren zonder een voorbeeld-bestand, maar kan die niet met een draaitabel + slicer?

Waarom zou je allemaal verschillende tabbladen gaan maken?

Veel reacties al in korte tijd, dank daarvoor.
Ik kan het bestand niet laten zien, vanwege privacy gevoelige informatie. Ik probeer het hieronder in een tabel versimpeld weer te geven:

TITEL 1	TITEL 2	TEAM
abcd	efgh	1
abcd	efgh	2
abcd	efgh	3

En zo spreek ik dan over veel meer kolommen en per week ongeveer 600 rijen.
Uit de rij TEAM moet dus gekeken worden of het team 1,2 of 3 is. Vervolgens moet de gehele tabel waarbij TEAM=1 naar een nieuw tabblad A, alles wat hoort bij TEAM=2 moet naar een nieuw tabblad B etc..

Wat ik nu doe is dat ik een filter zet op de eerste rij, vervolgens selecteer ik alleen "1" en kopieer ik alles handmatig naar een nieuw tabblad. Dit doe ik daarna ook voor 2,3,4,5 etc
Wekelijks stuur ik een rapportage en dan is het de bedoeling dat de manager van Team 1 heel gemakkelijk in dit bestand alleen "zijn" tabblad" hoeft te bekijken en niet overspoeld wordt met alle andere informatie.

Ik hoop dat dit het iets duidelijker maakt.

Ik kan eigenlijk helemaal geen VB, dus zelf een macro schrijven is lastig. Enige programmeertaal die ik kan is HTML/CSS en een heel klein beetje PHP

Als ik zo kijk naar de code van @japie06 kon dat wel eens de oplossing zijn.

[ Voor 6% gewijzigd door yorroy op 19-10-2017 14:32 ]

[breew]

Is het aantal teams altijd hetzelfde?

[yorroy]

breew schreef op donderdag 19 oktober 2017 @ 14:26:
Is het aantal teams altijd hetzelfde?

Ja die blijft gelijk

[breew]

Wellicht een domme vraag, maar waarom gebruikt de ontvanger zelf niet even een filter?

[breew]

kijk eens of dit werkt (en of je de code begrijpt ;-) )

Deze code werkt bij mij voor de aangeleveder voorbeeldcode. Om hem aan te paasen naar jouw situatie, zul je wijzigingen moeten doorvoeren in de teamnamen en het te filteren bereik (ik wilde je graag ook nog iets zelf laten doen ;-) ).

Visual Basic:

Option Explicit

Sub OmdatHetKan()

'declareren
Dim arrTeams() As Variant  'een array met alle teamnamen
Dim Team As Variant        'teamnaam, voor in de For-loop
Dim wsData As Worksheet    'werkblad met de brondata
Dim wsTeam As Worksheet    'werkblad per Team

'initialiseren
'vullen van een array met teamnamen
arrTeams = Array("1", "2", "3")
'het werkblad met brondata instellen
Set wsData = ActiveWorkbook.Sheets(1)

'loop door elke entry uit de array met teamnamen, noem de entry "Team"
For Each Team In arrTeams
    'voeg, na het laatste werkblad, een nieuw werkblad in, met als naam de waarde van variabele "Team"
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Team
    'stel dit werkblad in
    Set wsTeam = ActiveWorkbook.Sheets(Team)
    'maak in het werkblad "wsData" een autofilter op kolom C, met criterium de waarde van "Team"
    wsData.Range("$A$1:$C$4").AutoFilter Field:=3, Criteria1:=Team
    'kopieer het gefilterde bereik
    wsData.AutoFilter.Range.Copy
    'plak het gekopieerde, gefilterde bereik  in werkblad wsTeam
    wsTeam.Paste
    'haal het autofilter weg
    wsData.ShowAllData
Next Team

'weer terug naar de sheet met alle data
wsData.Activate

'KLAAR!!!

End Sub

[ Voor 10% gewijzigd door breew op 19-10-2017 15:33 . Reden: typo's ]

[breew]

japie06 schreef op donderdag 19 oktober 2017 @ 13:53:
Ik gebruik deze code om een sheet te splitten en twee sheets gebaseerd op een waarde in kolom E

code:

...

Als je hem verder wilt uitbreiden kun je denk meer van die Elseif statements toevoegen.

Dat werkt inderdaad ook prima, maar in een situatie van veel verschillende teamnamen, kan het volgens mij slimmer met een for-loop en een dynamisch autofilter. Dat houdt de code ook wat beter leesbaar , en is sneller dan steeds door alle rijen loopen (al zal het verschil in snelheid in de situatie van TS marginaal zijn)...

[yorroy]

breew schreef op donderdag 19 oktober 2017 @ 15:25:
kijk eens of dit werkt (en of je de code begrijpt ;-) )

Deze code werkt bij mij voor de aangeleveder voorbeeldcode. Om hem aan te paasen naar jouw situatie, zul je wijzigingen moeten doorvoeren in de teamnamen en het te filteren bereik (ik wilde je graag ook nog iets zelf laten doen ;-) ).

Visual Basic:

Option Explicit

Sub OmdatHetKan()

'declareren
Dim arrTeams() As Variant  'een array met alle teamnamen
Dim Team As Variant        'teamnaam, voor in de For-loop
Dim wsData As Worksheet    'werkblad met de brondata
Dim wsTeam As Worksheet    'werkblad per Team

'initialiseren
'vullen van een array met teamnamen
arrTeams = Array("1", "2", "3")
'het werkblad met brondata instellen
Set wsData = ActiveWorkbook.Sheets(1)

'loop door elke entry uit de array met teamnamen, noem de entry "Team"
For Each Team In arrTeams
    'voeg, na het laatste werkblad, een nieuw werkblad in, met als naam de waarde van variabele "Team"
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Team
    'stel dit werkblad in
    Set wsTeam = ActiveWorkbook.Sheets(Team)
    'maak in het werkblad "wsData" een autofilter op kolom C, met criterium de waarde van "Team"
    wsData.Range("$A$1:$C$4").AutoFilter Field:=3, Criteria1:=Team
    'kopieer het gefilterde bereik
    wsData.AutoFilter.Range.Copy
    'plak het gekopieerde, gefilterde bereik  in werkblad wsTeam
    wsTeam.Paste
    'haal het autofilter weg
    wsData.ShowAllData
Next Team

'weer terug naar de sheet met alle data
wsData.Activate

'KLAAR!!!

End Sub

Hmm dat ziet er wel uit alsof het te doen is. Ik begrijp in ieder geval redelijk de code die je uitgewerkt hebt.
Bedankt, dat ga ik eens proberen

[breew]

yorroy schreef op donderdag 19 oktober 2017 @ 16:09:
[...]

Hmm dat ziet er wel uit alsof het te doen is. Ik begrijp in ieder geval redelijk de code die je uitgewerkt hebt.
Bedankt, dat ga ik eens proberen

Succes!! Ik hoor het graag als je tegen zaken aanloopt, of als het gelukt is .
tip: gebruik F8 om door de code te 'stappen', en zet daarbij Beeld > Venster Lokale Variabelen aan... dan zie je live wat er gebeurt...

[yorroy]

breew schreef op donderdag 19 oktober 2017 @ 16:12:
[...]


Succes!! Ik hoor het graag als je tegen zaken aanloopt, of als het gelukt is .
tip: gebruik F8 om door de code te 'stappen', en zet daarbij Beeld > Venster Lokale Variabelen aan... dan zie je live wat er gebeurt...

Het is me niet gelukt, het is voor mij toch lastiger dan ik dacht.
Ik heb toch even een bestand gevoegd hoe het er uit ziet:
https://www.dropbox.com/s...e4/Voorbeeld.xlsx?dl=0&m=

Op deze manier komt het bestand uit het systeem. De inhoud van het bestand heb ik bewerkt uit privacyoverweging.
het tabblad "Toelichting_2" en "Pagina1_3" wordt ook gegenereerd maar heeft geen toegevoegde waarde.

Uit het eerste tabblad is de rij "i" (procesindicator" van belang.
Alles (de hele rij) wat uit deze kolom “I” de waarde "1" bevat moet gekopieerd of geknipt worden naar een nieuw blad met de naam "A".
Alles wat de waarde "2" bevat moet gekopieerd of geknipt worden naar een nieuw blad met de naam "B"

Moet dat met deze macro dan lukken?

[breew]

yorroy schreef op maandag 23 oktober 2017 @ 10:33:
[...]

Het is me niet gelukt, het is voor mij toch lastiger dan ik dacht.
Ik heb toch even een bestand gevoegd hoe het er uit ziet:
https://www.dropbox.com/s...e4/Voorbeeld.xlsx?dl=0&m=

Op deze manier komt het bestand uit het systeem. De inhoud van het bestand heb ik bewerkt uit privacyoverweging.
het tabblad "Toelichting_2" en "Pagina1_3" wordt ook gegenereerd maar heeft geen toegevoegde waarde.

Uit het eerste tabblad is de rij "i" (procesindicator" van belang.
Alles (de hele rij) wat uit deze kolom “I” de waarde "1" bevat moet gekopieerd of geknipt worden naar een nieuw blad met de naam "A".
Alles wat de waarde "2" bevat moet gekopieerd of geknipt worden naar een nieuw blad met de naam "B"

Moet dat met deze macro dan lukken?

Kijk, een voorbeeldbestand, dan helpt

A;ls ik het goed begrijp, moeten in jouw voorbeeld drie worksheets worden gemaakt: "1", "2" en "3".
Rij 4 moet op sheet 1
Rij 5 moet op sheet 2
Rij 6 moet op sheet 3

klopt dat?

[breew]

een paart kleine aanpassingen zorgen dat het werkt..

Visual Basic:

Option Explicit

Sub OmdatHetKan()

'declareren
Dim arrTeams() As Variant   'een array met alle teamnamen
Dim Team As Variant         'teamnaam, voor in de For-loop
Dim wsData As Worksheet     'werkblad met de brondata
Dim wsTeam As Worksheet     'werkblad per Team
Dim lonLaatsteRij As Long   'onderste rij met data (in kolom A) op wsData
Dim lonLaatsteKolom As Long 'meest rechter kolom met data (rij 3) op wsData
Dim rngData As Range        'het bereik in wsData dat gegevens bevat

'initialiseren
'vullen van een array met teamnamen
arrTeams = Array("1", "2", "3")
'het werkblad met brondata instellen
Set wsData = ActiveWorkbook.Sheets(1)

With wsData
  'onderste rij met data (in kolom A) bepalen
  lonLaatsteRij = .Cells(Rows.Count, 1).End(xlUp).Row
  'meest rechter kolom met data (op rij 3) bepalen
  lonLaatsteKolom = .Cells(3, Columns.Count).End(xlToLeft).Column
  'instellen bereik met data
  Set rngData = .Range(.Cells(3, 1), .Cells(lonLaatsteRij, lonLaatsteKolom))
End With

'loop door elke entry uit de array met teamnamen, noem de entry "Team"
For Each Team In arrTeams
    'voeg, na het laatste werkblad, een nieuw werkblad in, met als naam de waarde van variabele "Team"
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Team
    'stel dit werkblad in
    Set wsTeam = ActiveWorkbook.Sheets(Team)
    With wsData
      'maak in het werkblad "wsData" een autofilter op de negende kolom, met criterium de waarde van "Team"
      rngData.AutoFilter Field:=9, Criteria1:=Team
      'kopieer het gefilterde bereik
      .AutoFilter.Range.Copy
      'plak het gekopieerde, gefilterde bereik  in werkblad wsTeam
      wsTeam.Paste
      'haal het autofilter weg
      .ShowAllData
    End With
Next Team

'weer terug naar de sheet met alle data
wsData.Activate

'KLAAR!!!

End Sub

[yorroy]

breew schreef op maandag 23 oktober 2017 @ 11:49:
een paart kleine aanpassingen zorgen dat het werkt..

Visual Basic:

Option Explicit

Sub OmdatHetKan()

'declareren
Dim arrTeams() As Variant   'een array met alle teamnamen
Dim Team As Variant         'teamnaam, voor in de For-loop
Dim wsData As Worksheet     'werkblad met de brondata
Dim wsTeam As Worksheet     'werkblad per Team
Dim lonLaatsteRij As Long   'onderste rij met data (in kolom A) op wsData
Dim lonLaatsteKolom As Long 'meest rechter kolom met data (rij 3) op wsData
Dim rngData As Range        'het bereik in wsData dat gegevens bevat

'initialiseren
'vullen van een array met teamnamen
arrTeams = Array("1", "2", "3")
'het werkblad met brondata instellen
Set wsData = ActiveWorkbook.Sheets(1)

With wsData
  'onderste rij met data (in kolom A) bepalen
  lonLaatsteRij = .Cells(Rows.Count, 1).End(xlUp).Row
  'meest rechter kolom met data (op rij 3) bepalen
  lonLaatsteKolom = .Cells(3, Columns.Count).End(xlToLeft).Column
  'instellen bereik met data
  Set rngData = .Range(.Cells(3, 1), .Cells(lonLaatsteRij, lonLaatsteKolom))
End With

'loop door elke entry uit de array met teamnamen, noem de entry "Team"
For Each Team In arrTeams
    'voeg, na het laatste werkblad, een nieuw werkblad in, met als naam de waarde van variabele "Team"
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Team
    'stel dit werkblad in
    Set wsTeam = ActiveWorkbook.Sheets(Team)
    With wsData
      'maak in het werkblad "wsData" een autofilter op de negende kolom, met criterium de waarde van "Team"
      rngData.AutoFilter Field:=9, Criteria1:=Team
      'kopieer het gefilterde bereik
      .AutoFilter.Range.Copy
      'plak het gekopieerde, gefilterde bereik  in werkblad wsTeam
      wsTeam.Paste
      'haal het autofilter weg
      .ShowAllData
    End With
Next Team

'weer terug naar de sheet met alle data
wsData.Activate

'KLAAR!!!

End Sub

fantastisch! Deze macro toegepast in het originele bestand en uitgebreid met meer procesindicatoren, dat werkt top.

Ik durf het bijna niet te vragen, maar kan ik ook eenvoudig een nummer koppelen aan een naam?
Bijvoorbeeld bij 1 moet het blad “in behandeling” heten? En bij 2 weer wat anders?

[breew]

yorroy schreef op maandag 23 oktober 2017 @ 12:30:
Ik durf het bijna niet te vragen, maar kan ik ook eenvoudig een nummer koppelen aan een naam?
Bijvoorbeeld bij 1 moet het blad “in behandeling” heten? En bij 2 weer wat anders?

Dat kan vrij eenvoudig. Ik heb gekozen om een tweede array toe te voegen (arrSheetnamen). Zorg er voor dat deze altijd even lang is als de array met teams.
Vervolgens loopt een teller (i) van laag (0) tot hoog (ubound) door de array met teams, en maakt vervolgens sheets aan met de i-de entry in de array van arrSheetnamen.

Visual Basic:

Option Explicit

Sub OmdatHetKan()

'declareren
Dim arrTeams() As Variant   'een array met alle teamnamen
Dim arrSheetnamen() As Variant   'een array met alle ws-namen
Dim Team As Variant         'teamnaam, voor in de For-loop
Dim wsData As Worksheet     'werkblad met de brondata
Dim wsTeam As Worksheet     'werkblad per Team
Dim lonLaatsteRij As Long   'onderste rij met data (in kolom A) op wsData
Dim lonLaatsteKolom As Long 'meest rechter kolom met data (rij 3) op wsData
Dim rngData As Range        'het bereik in wsData dat gegevens bevat
Dim i As Long               'lusteller

'initialiseren
'vullen van een array met teamnamen
arrTeams = Array("1", "2", "3")
'vullen van een array met ws-namen
arrSheetnamen = Array("bladnaam 1", "bladnaam 2", "bladnaam 3")
'het werkblad met brondata instellen
Set wsData = ActiveWorkbook.Sheets(1)

With wsData
  'onderste rij met data (in kolom A) bepalen
  lonLaatsteRij = .Cells(Rows.Count, 1).End(xlUp).Row
  'meest rechter kolom met data (op rij 3) bepalen
  lonLaatsteKolom = .Cells(3, Columns.Count).End(xlToLeft).Column
  'instellen bereik met data
  Set rngData = .Range(.Cells(3, 1), .Cells(lonLaatsteRij, lonLaatsteKolom))
End With

'loop door elke entry uit de array met teamnamen (van 0 tot de bovengrens), gebruik i als indexnummer
For i = 0 To UBound(arrTeams)
    'voeg, na het laatste werkblad, een nieuw werkblad in, met als naam de waarde van de i-de entry in arrSheetnamen
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = arrSheetnamen(i)
    'stel dit werkblad in
    Set wsTeam = ActiveWorkbook.Sheets(arrSheetnamen(i))
    With wsData
      'maak in het werkblad "wsData" een autofilter op de negende kolom, met criterium de waarde van van de i-de entry in arrTeams
      rngData.AutoFilter Field:=9, Criteria1:=arrTeams(i)
      'kopieer het gefilterde bereik
      .AutoFilter.Range.Copy
      'plak het gekopieerde, gefilterde bereik  in werkblad wsTeam
      wsTeam.Paste
      'haal het autofilter weg
      .ShowAllData
    End With
Next i

'weer terug naar de sheet met alle data
wsData.Activate

'KLAAR!!!

End Sub

[yorroy]

breew schreef op maandag 23 oktober 2017 @ 12:50:
[...]


Dat kan vrij eenvoudig. Ik heb gekozen om een tweede array toe te voegen (arrSheetnamen). Zorg er voor dat deze altijd even lang is als de array met teams.
Vervolgens loopt een teller (i) van laag (0) tot hoog (ubound) door de array met teams, en maakt vervolgens sheets aan met de i-de entry in de array van arrSheetnamen.

Visual Basic:

Option Explicit

Sub OmdatHetKan()

'declareren
Dim arrTeams() As Variant   'een array met alle teamnamen
Dim arrSheetnamen() As Variant   'een array met alle ws-namen
Dim Team As Variant         'teamnaam, voor in de For-loop
Dim wsData As Worksheet     'werkblad met de brondata
Dim wsTeam As Worksheet     'werkblad per Team
Dim lonLaatsteRij As Long   'onderste rij met data (in kolom A) op wsData
Dim lonLaatsteKolom As Long 'meest rechter kolom met data (rij 3) op wsData
Dim rngData As Range        'het bereik in wsData dat gegevens bevat
Dim i As Long               'lusteller

'initialiseren
'vullen van een array met teamnamen
arrTeams = Array("1", "2", "3")
'vullen van een array met ws-namen
arrSheetnamen = Array("bladnaam 1", "bladnaam 2", "bladnaam 3")
'het werkblad met brondata instellen
Set wsData = ActiveWorkbook.Sheets(1)

With wsData
  'onderste rij met data (in kolom A) bepalen
  lonLaatsteRij = .Cells(Rows.Count, 1).End(xlUp).Row
  'meest rechter kolom met data (op rij 3) bepalen
  lonLaatsteKolom = .Cells(3, Columns.Count).End(xlToLeft).Column
  'instellen bereik met data
  Set rngData = .Range(.Cells(3, 1), .Cells(lonLaatsteRij, lonLaatsteKolom))
End With

'loop door elke entry uit de array met teamnamen (van 0 tot de bovengrens), gebruik i als indexnummer
For i = 0 To UBound(arrTeams)
    'voeg, na het laatste werkblad, een nieuw werkblad in, met als naam de waarde van de i-de entry in arrSheetnamen
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = arrSheetnamen(i)
    'stel dit werkblad in
    Set wsTeam = ActiveWorkbook.Sheets(arrSheetnamen(i))
    With wsData
      'maak in het werkblad "wsData" een autofilter op de negende kolom, met criterium de waarde van van de i-de entry in arrTeams
      rngData.AutoFilter Field:=9, Criteria1:=arrTeams(i)
      'kopieer het gefilterde bereik
      .AutoFilter.Range.Copy
      'plak het gekopieerde, gefilterde bereik  in werkblad wsTeam
      wsTeam.Paste
      'haal het autofilter weg
      .ShowAllData
    End With
Next i

'weer terug naar de sheet met alle data
wsData.Activate

'KLAAR!!!

End Sub

Prachtig, het werkt als een trein. Super leerzaam ook.
Bedankt @breew

[breew]

yorroy schreef op maandag 23 oktober 2017 @ 13:58:
[...]

Prachtig, het werkt als een trein. Super leerzaam ook.
Bedankt @breew

Scheelt je weer een uurtje klikken per week

[Verwijderd]

Wat een fraaie macro met uitleg!
Ik heb een Excel tabel met bankgegevens. Aan iedere regel heb ik een grootboeknummer toegevoegd. Met de macro wordt nu per grootboek een tabblad gegenereerd met de betreffende regels in dat tabblad.
Zodra ik weer nieuwe bankregels heb toegevoegd verwijder ik eerst alle eerder aangemaakte tabbladen. Daarvoor heb ik na het blok " 'declareren " deze regels toegevoegd:

'schone start

Sheets(Array("1", "2", "3")).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

[ Voor 26% gewijzigd door Verwijderd op 15-06-2018 10:29 . Reden: foutje in code ]

[Caba]

Prima code! Heb de laatst gepubliceerde code gebruikt.

Klein, maar voor mij nu nog net te groot, probleem!

Op alle gesplitste tabbladen komt A1 van het bronblad terug.
Hoe los ik dat op?
B.v. dank

[heuveltje]

code:

Sheets(1).Name = "NewName"

de (1) geeft het bladnr aan.

[g0tanks]

Caba schreef op woensdag 8 april 2020 @ 16:40:
Prima code! Heb de laatst gepubliceerde code gebruikt.

Klein, maar voor mij nu nog net te groot, probleem!

Op alle gesplitste tabbladen komt A1 van het bronblad terug.
Hoe los ik dat op?
B.v. dank

Welkom op Tweakers.

We hebben liever niet dat je oude topics omhoog haalt. Bij nieuwe vragen kan je het beste een eigen topic openen, waarbij je natuurlijk mag refereren naar deze code. Let daarbij op dat we eigen inzet verwachten, dus geef duidelijk aan wat je eerst zelf hebt geprobeerd. Dit topic gaat in ieder geval op slot.