Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1368to1372
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

VBA Register bedingt erzeugen

VBA Register bedingt erzeugen
06.07.2014 15:04:59
Uwe
Folgendes Problem:
Habe eine Datei mit den Registern Paketnummern und Muster
Dort habe ich ein Makro, welches neue Tabellenblätter erzeugt
In Paketnummern stehen ab Zeile 6 in Spalte A die neuen Namen.
Anhand dieser Namen erzeugt das Makro neue Tabellenblätter als Kopie von Muster.
Soweit arbeitet das Makro problemlos.
Ich möchte aber nur bestimmte Tabellenblätter erzeugen.
Dafür steht in Spalte C ein x ( x = angewählt)
Nur dann soll ein neues Batt erzeugt werden.
Mein Makro hat zusätzlich den Fehler, dass falls in Spalte A Zeilen keine Eintragungen haben eine Fehlermeldung kommt.
Dh. es dürfen nur neue Blätter erzeugt werden, wenn in A eine entsprechende Eintragung und in C ein x für die Anwahl steht.
Im Anhang ist die besagte Datei.
https://www.herber.de/bbs/user/91401.xls
Kann mir bitte Jemand mein Makro verbessern?
Vielen Dank
Uwe

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Register bedingt erzeugen
06.07.2014 17:06:16
Beverly
Hi Uwe,
versuche es mal so:
Sub Arbeitsblätter_anlegen()
Dim rngMuster As Range, calcOld As XlCalculation, zz As Long, ss As Long
Dim Calc As XlCalculation
Calc = Application.Calculation: Beschleuniger xlCalculationManual
Set rngMuster = Sheets("Muster").Columns("A:J")
With Sheets("Paketnummern")
' in Spalte A Zeile 6 von Tabelle "Paketnummern" steht die erste Paketnummer
For zz = 6 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(zz, 1)  "" Then
If .Cells(zz, 3) = "x" Then
If IsError(Evaluate("'" & .Cells(zz, 1).Value & "'!A1")) Then
Worksheets.Add after:=Sheets(Sheets.Count)
rngMuster.Copy Cells(1, 1)
'in Zeile 3 Spalte B wird der Tabellenblattname abgelegt
Cells(3, 2) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(3, 2))
End If
End If
End If
Next zz
End With
Beschleuniger Calc
End Sub


Anzeige
AW: VBA Register bedingt erzeugen
06.07.2014 22:43:07
Uwe
Danke, das Makro funktioniert wunderbar.
Jetzt habe ich aber festgestellt, dass die neuen Tabellenblätter anders formatiert sind.
Dh. auch wenn Muster im Querformat angelegt wurde, bzw. die Seitenränder geändert wurden, sind die neuen Blätter im Hochformat.
Kannst Du bitte das Makro derart erweitern, dass die Formatierung mitgenommen wird?
Vielen Dank
Uwe

AW: VBA Register bedingt erzeugen
06.07.2014 23:11:22
Beverly
Hi Uwe,
das Tabellenblatt wird als Kopie deiner Mustervorlage erstellt. Was meinst du mit Hoch- und Querformat? Welche Seitenränder wurden wo geändert?


Anzeige
AW: VBA Register bedingt erzeugen
06.07.2014 23:58:36
Uwe
Das scheint keine vollständige Kopie von Muster zu sein.
Der Schriftfuss fehlt,
Die Zeilenhöhe steht auf Standard
und die Seitenausrichtung ist auch auf Standard
Auch die Seitenränder sind Standard
mfG
Uwe

AW: VBA Register bedingt erzeugen
07.07.2014 08:34:42
Beverly
Hi Uwe,
du kopierst nicht das gesamte Tabellenblatt sondern nur einen Zellbereich in ein neues Tabellenblatt - dieses hat selbstverständlich die Standardeinstellungen. Kopiere das gesamte Tabellenblatt, dann werden auch alle Einstellungen mit übernommen.
Sub Arbeitsblätter_anlegen()
Dim calcOld As XlCalculation, zz As Long, ss As Long
Dim Calc As XlCalculation
Calc = Application.Calculation: Beschleuniger xlCalculationManual
With Sheets("Paketnummern")
' in Spalte A Zeile 6 von Tabelle "Paketnummern" steht die erste Paketnummer
For zz = 6 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(zz, 1)  "" Then
If .Cells(zz, 3) = "x" Then
If IsError(Evaluate("'" & .Cells(zz, 1).Value & "'!A1")) Then
Worksheets("Muster").Copy After:=Sheets(Sheets.Count)
'in Zeile 3 Spalte B wird der Tabellenblattname abgelegt
Cells(3, 2) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(3, 2))
End If
End If
End If
Next zz
End With
Beschleuniger Calc
End Sub
In deiner Mappe kann ich übrigens keinerlei Einstellung dieses Tabellenblattes finden, die nicht den Standardegeinschaften entsprechen.


Anzeige
AW: VBA Register bedingt erzeugen
07.07.2014 16:28:21
Uwe
Super,
jetzt habe ich genau das Makro was ich brauche.
Habe das ursprüngliche Makro aus einer anderen Datei kopiert.
Dabei aber übersehen, dass nur ein Bereich kopiert wird.
In meiner letztendlichen Arbeitsmappe habe ich in Muster Schriftfuss etc.
mochmals vielen Dank.
mit freundlichen Grüßen
Uwe

Dein Denkfehler
07.07.2014 08:36:20
Matthias
Hallo
Es wir ja nicht das Tabellenblatt kopiert sondern nur der Bereich Sheets("Muster").Columns("A:J")
den Du ja hier mit Set referenzierst.
Set rngMuster = Sheets("Muster").Columns("A:J")
Diesen Bereich übergibst Du an ein neu erstelltes Tabellenblatt
Worksheets.Add after:=Sheets(Sheets.Count)
rngMuster.Copy Cells(1, 1)
Das ist ja dann keine Kopie vom Tabellenblatt "Muster"
Gruß Matthias

Anzeige
AW: VBA Register bedingt erzeugen
06.07.2014 23:15:24
Uwe
Habe zwischenzeitlich das Querformat geschafft.
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.Orientation = xlLandscape
End With
Jetzt fehlt aber auch der Schriftfuss etc.
Gibt es eine Möglichkeit alle Parameter von Muster zu kopieren?
Danke
mfG
Uwe

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige