Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1700to1704
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenblätter auitomatisch erstellen und füllen

Tabellenblätter auitomatisch erstellen und füllen
18.07.2019 13:22:39
Daniel
Hallo zusammen,
ich benötige eure Hilfe.
Ich habe eine Tabelle mit Mannschaften und Spielern und möchte diese nun gerne automatisch in neue Tabellenblätter einfügen.
Der Aufbau sieht so aus:
Mannschaft1 Spieler1
Mannschaft1 Spieler2
Mannschaft1 Spieler3
Mannschaft1 Spieler4
Mannschaft2 Spieler1
Mannschaft2 Spieler2
Mannschaft2 Spieler3
Mannschaft2 Spieler4
Hättet ihr einen Codeschnipsel den ich verwenden kann ?
Vielen Dank für eure Hilfe!

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
erwartest du ernsthaft...
18.07.2019 13:36:35
Werner
Hallo Daniel,
...Hilfe mit einem "Codeschnipsel" bei der Problembeschreibung?
Gruß Werner
AW: erwartest du ernsthaft...
18.07.2019 13:41:40
Daniel
Ich kann das auch gerne noch spezifizieren:
Ich habe eine Excelliste mit einer Tabelle1. Die Daten sind wie folgt dort eingetragen:
Mannschaft1 Spieler1
Mannschaft1 Spieler2
Mannschaft1 Spieler3
Mannschaft1 Spieler4
Mannschaft2 Spieler1
Mannschaft2 Spieler2
Mannschaft2 Spieler3
Mannschaft2 Spieler4
Daraus möchte ich gerne einzelne Tabellenblätter mit dem Namen der Mannschaft erstellen und die Spieler dort eintragen.
Tabelle "Mannschaft1" mit den Spielern 1-4
Tabelle "Mannschaft2" mit den Spielern 1-4 usw.
Gruß
Daniel
Anzeige
evtl. so
19.07.2019 14:59:17
KlausF
Moin Daniel,
Sheetnamen müssen in Spalte A stehen, Spielernamen entsprechend in Spalte B.
Dann probier mal
Sub Aufteilen()
Dim lngLast As Long, i As Long
Dim strName As String
Dim actSheet As Worksheet
Set actSheet = ActiveSheet
lngLast = actSheet.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With actSheet
For i = 1 To lngLast Step 4
strName = .Range("A" & i)
If SheetExist(strName) Then Worksheets(strName).Delete
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = strName
actSheet.Range("B" & i & ":B" & i + 3).Copy Destination:=ActiveSheet.Range("A1")
Next i
End With
Set actSheet = Nothing
Application.DisplayAlerts = True
End Sub
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Worksheets
If wks.Name = sheetName Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function
Gruß
Klaus
Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige