Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1032to1036
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

Hilfe bei Makro

Hilfe bei Makro
29.12.2008 01:46:54
Markus
Hallo zusammen,
will hoffen ihr habt die Feiertage gut überstanden?
Ich habe da gleich mal ein Problem:
Das folgende Makro soll auch das Privat Sub aus der Tabelle "Muster" mit in die neuen Blätter kopieren,
wie müßte das Makro dann lauten?
Vielen Dank im Voraus.
Gruß Markus

Sub Blätter_erstellen()
Dim Zelle As Range
With Sheets("Vorgaben")
On Error Resume Next
For Each Zelle In .Range(.Cells(8, 2), .Cells(105, 2).End(xlUp)).SpecialCells(  _
_xlCellTypeConstants)
Err = 0
Sheets(Zelle.Value).Select
Select Case Err
Case 0
Case Else
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Zelle.Value
Sheets("Muster").Cells.Copy Destination:=ActiveSheet.Cells
Range("A7").Select
ActiveWindow.FreezePanes = True
Range("D8").Select
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
End Select
Next
On Error GoTo 0
End With
Application.DisplayAlerts = False
Sheets("Ende").Delete
Application.DisplayAlerts = True
Sheets("Vorgaben").Select
Range("C2").Select
End Sub


6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe bei Makro
29.12.2008 09:30:00
Beverly
Hi Markus,
kopiere das gesamte Tabellenblatt, dann wird auch das Codemodul mit kopiert:

Sub Blätter_erstellen()
Dim Zelle As Range
With Sheets("Vorgaben")
For Each Zelle In .Range(.Cells(8, 2), .Cells(105, 2).End(xlUp)).SpecialCells( _
xlCellTypeConstants)
Sheets("Muster").Copy after:=Sheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Zelle.Value
If Err = 0 Then
Range("A7").Select
With ActiveWindow
.FreezePanes = True
.DisplayGridlines = False
.DisplayHeadings = False
End With
End If
On Error GoTo 0
Next
End With
End Sub




Anzeige
AW: Hilfe bei Makro
29.12.2008 13:51:00
Markus
Danke Katrin,
funktioniert aber nicht richtig, da dein Makro noch eine weitere Kopie von "Muster" erzeugt, welche ich nicht benötige.
Hast du noch eine Idee?
Danke und Gruß Markus
AW: Hilfe bei Makro
29.12.2008 14:40:00
Beverly
Hi Markus,
ich habe deinen Code nicht getestet, aber ich interpretiere ihn wie folgt: du fügst ein neues Tabellenblatt ein, gibst im den Namen aus Spalte B im Tabellenblatt "Vorgaben" und kopierst alle Zellen des Tabellenblattes "Muster" in das neu erstellte Tabellenblatt. Das wiederholst du in einer Schleife über alle Zellen in Spalte B des Tabellenblattes "Vorgaben". Was ist da der Unterschied zu meinem Code, der das Tabellenblatt "Muster" komplett (einschließlich dem enthaltenen Code) kopiert und dann dem neu erstellten Tabellenblatt den Namen aus Spalte B "Vorgaben" gibt?


Anzeige
AW: Hilfe bei Makro
29.12.2008 15:24:45
Markus
Hi Katrin,
genau richtig, doch wenn ich das Makro ausführe, und nur in "Vorgaben" B11 und B13 ein Name steht, werden dazwischen auch noch Blätter mit Muster (2) usw. erstellt.
Es sollte so sein, daß leere Zellen ignoriert werden.
Gruß Markus
AW: Hilfe bei Makro
29.12.2008 19:06:00
Beverly
Hi Markus,
ich war davon ausgegangen, dass keine leeren Zellen vorkommen.

Sub Blätter_erstellen2()
Dim Zelle As Range
With Sheets("Vorgaben")
For Each Zelle In .Range(.Cells(8, 2), .Cells(105, 2).End(xlUp)).SpecialCells( _
xlCellTypeConstants)
If Zelle.Value  "" Then
Sheets("Muster").Copy after:=Sheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Zelle.Value
If Err = 0 Then
Range("A7").Select
With ActiveWindow
.FreezePanes = True
.DisplayGridlines = False
.DisplayHeadings = False
End With
Else
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End If
On Error GoTo 0
End If
Next
End With
End Sub




Anzeige
AW: Hilfe bei Makro
29.12.2008 19:51:37
Markus
Hallo Karin,
Super - Danke, es funktioniert!!!!!!!!!!!!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige