Volgend tabblad

[Krist]

Hallo,

Ik zou een overzicht willen maken van individuele trainingen.
Individueel vul ik in op een tabblad. In een algemeen tabblad zou dan automatisch de gegevens van tablad 1 moeten komen. Indien er op een rij geen gegevens meer staan, moet er dan naar tabblad 2 gegaan worden. enz...
Heb dit nu manueel gedaan in het document in bijlage. Kan dit automatisch?

Alvast dank!

 

[AlexCEL]

Ik zie geen algemeen tabblad in bijlage. Is het de bedoeling dat de gegevens uit alle tabbladen onder elkaar komen te staan?

 

[emields]

zou dit geen betere oplossing zijn?

 

[Krist]

Goedemorgen,

Bedoeling is inderdaad dat de gegevens uit de tabbladen 1,2,3,... in het tabblad 'team' onder elkaar komen te staan.
@emields: de tabbladen worden ingevuld door verschillende mensen. Het overzicht van alle personen onder elkaar iw el belangrijk. Toch bedankt!

groeten,
Krist

 

[emields]

bedoel je dan zoiets?

 

[Krist]

Ja! Inderdaad... Amaai, dat had ik nooit gevonden

Deze range is voor het aantal trainingen? For Each cell In Worksheets(i).Range("a4:a10")
If cell <> "" Then
Deze range snap ik niet? With Sheets("blad1").Range("a100").End(xlUp)
Wat is a1 .Offset(1).Resize(, 2) = Worksheets(i).Range("a1").Resize(, 2).Value
.Offset(1, 2).Resize(, 3) = cell.Resize(, 3).Value
End With
End If
Next
En deze? 'Worksheets(I).Range("a4:a20").claercontents

Alvast dankjewel

 

[emields]

uitleg in de code

 

[HSV]

Waarom een limiet tot rij 100?

With Sheets("blad1").Range("a100").End(xlUp)

Onderstaande lijkt me veel geschikter.

With Sheets("blad1")[COLOR=#ff0000].cells(rows.count,1)[/COLOR].End(xlUp)

 

[VenA]

Hoeveel moeite is het om de naam van een persoon in B1 te typen? De functie CEL() is volatiel en als er meerdere mensen in een bestand werken dan bestaat de kans dat sommigen gebruik maken van een andere taalinstelling en dan werkt de formule in B1 niet.

De code kan ook veel sneller en dynamischer. Kost een paar regels meer maar dat maakt niet zoveel uit.

Sub VenA()
  Dim sh As Worksheet, c00 As String, j As Long, x As Long, ar1
  ReDim ar(3, 0) 'in deze array worden de gegevens verzameld
  For Each sh In Sheets 'Wandel door elk werkblad
    c00 = sh.Name 'zet de naam van het blad in deze variable
    If c00 <> "team" Then 'Als de naam van het blad ongelijk is aan team dan
      ar1 = sh.Range("A3:C" & Application.Max(3, sh.Cells(Rows.Count, 1).End(xlUp).Row)) 'Zet de ingevoerde gegevens vanaf A3 in een nieuwe array
      If UBound(ar1) > 1 Then 'Als er minimaal 1 gegeven in kolom A onder de koptekst staat dan
        For j = 2 To UBound(ar1) 'Doorloop de array
          x = UBound(ar, 2) 'Bepaal de laatse positie van deze array
          ar(0, x) = c00 'hier komt de naam zoals de tabnaam heet
          ar(1, x) = CDbl(ar1(j, 1)) 'de datum geconverteerd naar getal
          ar(2, x) = ar1(j, 2) 'de training
          ar(3, x) = ar1(j, 3) 'de actie
          ReDim Preserve ar(3, x + 1) 'Reserveer ruimte voor een volgende regel
        Next j 'volgende in de array ar1
      End If 'einde 2e voorwaarde
    End If 'einde 1e voorwaarde
  Next sh 'volgende blad
  'nog even wegschrijven naar een tabel
  With Sheets("team").ListObjects(1)
    If .ListRows.Count > 0 Then .DataBodyRange.Delete 'als er al gegevens in staan dan deze verwijderen
    .ListRows.Add.Range.Resize(x + 1, 4) = Application.Transpose(ar) 'zet de verzamelde gegevens in de tabel
  End With
End Sub

 

[HSV]

Maak in B1 gebruik van:

CEL("filename"

Werkt ook in Ned. versie.

 

[Krist]

Bedankt aan allen... Mooie oplossingen en duidelijke uitleg. Heel wat bijgeleerd!