Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenblätter nach Liste generieren

Tabellenblätter nach Liste generieren
16.03.2015 15:34:53
Daniel
Hallo Ihr Lieben,
ich habe ein problem mit VBA:
Meine Excel Datei hat bisher 2 Laschen.
In Lasche 1 befindet sich eine Liste mit Nachnamen in Spalte D.
Die Vornamen stehen in Spalte C.
Aus diesen Werten sollen neue Tabellenblätter mit dem Namen angelegt werden.
Das bekomme eher bescheiden mit den Nachnamen hin und auch nur soweit keine doppelten (Namens)-Werte in Spalte D vorkommen mit:
Sub tabneu()
Dim i, z As Double
ActiveSheet.Range("A:A").End(xlDown).Offset(1, 0).Select
z = ActiveCell.Row
z = z - 1
For i = 1 To z
Sheets(2).Copy after:=Sheets(2)
ActiveSheet.Name = Sheets(1).Cells(z, 4).Value
z = z - 1
Next i
End Sub

Wie kann ich es schaffen, dass der Code mit den Dopplungen umgehen/weiterarbeiten kann? Auch mdie Kombination Name und Vorname kann doppelt vorkommen.
Die neu angelegten Tabellenblätter sollen außerdem wie ein Musterformular in Tabellenblatt2 aufgebaut sein. Perfekt wäre es wenn diese noch den Vor- und Nachnamen in Zellen C4:D4 und C8:D8 hätten.
Ich bin für alles dankbar was mich der Lösung näher bringt.
Vielen Dank
Daniel

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblätter nach Liste generieren
16.03.2015 22:08:32
Tobias
Hallo Daniel,
Versuch das mal

Option Explicit
Sub tabneu()
Dim iZeile As Long
Dim NameGanz As String
For iZeile = 1 To Sheets(1).Cells(65536, 1).End(xlUp).Row
NameGanz = Sheets(1).Cells(iZeile, 4) & ", " & Sheets(1).Cells(iZeile, 3)
If SheetEx(NameGanz) = False Then
Sheets(2).Copy after:=Sheets(2)
ActiveSheet.Name = NameGanz
ActiveSheet.Cells(4, 3).Value = Sheets(1).Cells(iZeile, 3).Value
ActiveSheet.Cells(4, 4).Value = Sheets(1).Cells(iZeile, 4).Value
ActiveSheet.Cells(8, 3).Value = Sheets(1).Cells(iZeile, 3).Value
ActiveSheet.Cells(8, 4).Value = Sheets(1).Cells(iZeile, 4).Value
End If
Next iZeile
End Sub
Function SheetEx(strNam As String) As Boolean
On Error Resume Next
SheetEx = Sheets(strNam).Index > 0
End Function

Anzeige
AW: Tabellenblätter nach Liste generieren
17.03.2015 14:26:06
Daniel
Lieber Tobias,
vielen Dank für deine schnelle Hilfe. Dein Code funktioniert tadelos :)
Gruß
Daniel

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige