Office: Alle Zeilen durchlaufen und prüfen

Liebe VBA-Profis

Ich habe ein Makro erstellt, welches aktuell im Tabellenblatt "Grunddaten" in Zeile 3 die Zelle A3 überprüft. Wenn dort ein "x" steht, wird ein Vorlagen-Tabellenblatt kopiert, in welches dann die gesamte Zeile 3 aus dem Tabellenblatt "Grunddaten" kopiert und das Tabellenblatt umbenennt wird.

Gerne würde ich das Makro so erweitern, dass alle Zeilen (ab Zeile 3) aus dem Tabellenblatt "Grunddaten" in Spalte A auf ein "x" überprüft werden und so weitere Tabellenblätter hinzugefügt werden (falls ein x dort steht). Es müsste bei den neu erstellten Tabellenblättern natürlich jeweils die zugehörige Zeile eingefügt werden. Wie müsste ich den Code anpassen?

Ganz herzlichen Dank für eure Hilfe, Matthias

Application.ScreenUpdating = False
Sheets("Grunddaten").Select
If Range("A3").Value = "x" Then
Sheets("Vorlage").Select
Sheets("Vorlage").Copy Before:=Sheets(1)
Sheets("Grunddaten").Select
Rows("3:3").Select
Selection.Copy
Sheets("Vorlage (2)").Select
Rows("1:1").Select
ActiveSheet.Paste
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Sheets("Vorlage (2)").Move After:=Sheets(3)
Dim Zelle As String
Zelle = "E5"
ActiveSheet.Name = ActiveSheet.Range(Zelle).Text
End If
Sheets("Grunddaten").Select
Application.ScreenUpdating = True
End Sub

:)

 

Hallo,

reicht doch schon eine Schleife über die Zellen ...

Code:

Deinen Grusel-Code umzubauen, da hab ich keine Lust.

 

Guten Morgen

Vielen Dank für die rasche Antwort.

Die Tabellenblätter werden einwandfrei erstellt. Leider wird die jeweilige Zeile aus dem Tabellenblatt "Grunddaten" nur in das erste, neu erstellte Tabellenblatt übernommen. Gerne möchte ich aber jeweils die passende Zeile in jedes neu erstellte Tabellenblatt reinkopiert haben.

Es wird wohl am folgenden Code-Abschnitt liegen:

Sheets("Grunddaten").Select
Rows("3:3").Select
Selection.Copy
Sheets("Vorlage (2)").Select
Rows("1:1").Select
ActiveSheet.Paste

Wie müsste ich das umschreiben?

GANZ HERZLICHEN DANK und viele Grüsse, Matthias

Hier nochmals der gesamte Code:

Dim aletzte As Long
Dim Zelle As Range
With Sheets("Grunddaten")
aletzte = .Cells(Rows.Count, 1).End(xlUp).Row
For Each Zelle In .Range("A3:A" & CStr(aletzte))
Application.ScreenUpdating = False
Sheets("Grunddaten").Select
If Range("A3").Value = "x" Then
Sheets("Vorlage").Select
Sheets("Vorlage").Copy Before:=Sheets(1)
Sheets("Grunddaten").Select
Rows("3:3").Select
Selection.Copy
Sheets("Vorlage (2)").Select
Rows("1:1").Select
ActiveSheet.Paste
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Sheets("Vorlage (2)").Move After:=Sheets(3)
Dim Zelle As String
Zelle = "E5"
ActiveSheet.Name = ActiveSheet.Range(Zelle).Text
End If
Sheets("Grunddaten").Select
Application.ScreenUpdating = True
Next Zelle
End With
End Sub

 

Hey,

mach es so:

Code:

Bitte nutze doch in Zukunft die CODE Tags um deinen Code zu posten.

Gruß
Thomas

 

Guten Morgen Thomas

Wow - ganz HERZLICHEN DANK! Funktioniert einwandfrei. Kurze Frage noch: kann man die neu erstellen Tabellenblätter jeweils nach Zellinhalt "C1" + "D1" umbenennen?

Viele Grüsse, Matthias

 

Hey,

nö geht nicht.

Wenn in C1 zum Beispiel "Test" steht und in D1 "123" würde das neue Sheet Test123 heißen.
Soweit so gut beim nächsten Treffer würde man ja, nach deiner Aufgabenstellung, wieder den Inhalt aus C1 und D1 nehmen.
Und das würde auf einen Fehler laufen da die Blätter keinen identischen Namen haben dürfen...

Gruß
Thomas

 

Ganz herzlichen Dank trotzdem!

Viele Grüsse, Matthias

 

Du hättest Dir natürlich auch was anderes einfallen lassen können mit dem Namen. Aber ok *Smilie