Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1464to1468
1464to1468
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Neue Arbeitsblatt

Forumthread: Neue Arbeitsblatt

Neue Arbeitsblatt
18.12.2015 11:09:20
Armin
Hallo Freunde,
ich habe eine Frage und Zwar:
ich möchte eine Makro schreiben, wenn ich in einer Zelle in der Spalte "B1" einen Name z.B "TEST1" schriebe,soll eine neue Arbeitsblatt erzeugt werden mit der selben Name wie in "B1" nämlich "TEST1" und soll einen betimmmten Layout haben.
Das soll auch genau bei "B2" passieren, d.h. wenn ich eine Name in "B2" schreibe z.B "TEST2" soll selber wie oben passieren aber sleber Layout behalten wie "TEST1" haben.
wie geht das?

Anzeige

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Neue Arbeitsblatt
18.12.2015 11:43:50
Michael
Hallo Armin!
Als Bsp.: https://www.herber.de/bbs/user/102339.xlsm
Erstelle ein Tabellenblatt als Vorlage - dieses Blatt wird dann entsprechend kopiert, wenn in einem bestimmten Bereich Werte eingegeben werden. Beachte auch die Fehlerüberprüfungen, müssen ggf. noch erweitert werden!
Code in Modul1 sowie Tabellenblatt "Steuerung".
Passt?
LG
Michael

Anzeige
AW: Bessere Version > Unerlaubte Zeichen...
18.12.2015 12:51:08
Michael

Die Datei https://www.herber.de/bbs/user/102343.xlsm wurde aus Datenschutzgründen gelöscht


LG
Michael

AW: Bessere Version > Unerlaubte Zeichen...
21.12.2015 10:57:34
Armin
Vielen Dank Michael..passt perfekt!
ich habe noch eine Frage und Zwar wie können die Daten aus der Zwischenablge in disem bestimmten Bereich kopiert werden und nach dem Enter-Drucken, werden die in diesem bestimmten Bereich hinzugefügten datein entsprechenden Namen die neue Blätter erzeugt werden..
Was soll ich in deinem Makro ändern?
Sub VorlageKopieren(wsBez As String)
Dim i As Integer
Dim Weiter As Boolean
Application.ScreenUpdating = False
Weiter = False
wsBez = Replace(wsBez, ":", "")
wsBez = Replace(wsBez, "\", "")
wsBez = Replace(wsBez, "/", "")
wsBez = Replace(wsBez, "?", "")
wsBez = Replace(wsBez, "*", "")
wsBez = Replace(wsBez, "[", "")
wsBez = Replace(wsBez, "]", "")
With ThisWorkbook
For i = 1 To .Sheets.Count
If LCase(.Worksheets(i).Name) = LCase(wsBez) Then
MsgBox "Dieses Blatt existiert bereits!"
Exit Sub
End If
Next
Select Case Len(wsBez)
Case Is > 31
wsBez = Left(wsBez, 31)
Case Is = 0
If MsgBox("Zelle ist leer - Standardname für neues Blatt vergeben?",  _
vbYesNo) = vbYes Then _
Weiter = True
Case Else
wsBez = wsBez
End Select
.Worksheets("Vorlage").Copy After:=Sheets(.Sheets.Count)
If Weiter Then
.ActiveSheet.Name = "Blatt " & .Sheets.Count + 1
Else: .ActiveSheet.Name = wsBez
End If
End With
Worksheets("Steuerung").Activate
Application.ScreenUpdating = True
End Sub

Anzeige
Bahnhof...
22.12.2015 08:49:28
Michael
Hallo Armin!
Du willst was? Sorry, ich hab keine Ahnung worauf Du hinaus willst!
Lg
Michael

AW: Neue Arbeitsblatt
18.12.2015 11:47:09
hary
Moin
Am einfachsten du erstellst ein Vorlagenblatt mit deinem ganzen Layout und kopierst es und vergibst den Namen.
Du brauchst Tabelle1 und ein Blatt mit dem Namen: Vorlage
Code in den Code der Tabelle1. 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bereich As Range
If Target.Count > 1 Then Exit Sub
Set bereich = Range("B1:B2") '---erweiterbar
If Not Intersect(Target, bereich) Is Nothing Then
If Not SheetExist(Target) Then
Worksheets("Vorlage").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Target
Else
MsgBox "Blattname schon vorhanden", vbInformation
End If
End If
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 LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function

gruss hary

Anzeige
AW: Soo viele Wege führen nach Rom ;-), LG (owT)
18.12.2015 11:50:19
Michael

AW: noch ein weg nach Rom und ... ;-)
18.12.2015 12:07:40
hary
Moin Michael
..und Fehler(wenn Target leer) beseitigt. 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bereich As Range
If Target.Count > 1 Then Exit Sub
Set bereich = Range("B1:B2") '---erweiterbar
If Not Intersect(Target, bereich) Is Nothing And Target  "" Then
If IsError(Evaluate(Target & "!A1")) Then '--hier Pruefung ob Blatt vorhanden
Worksheets("Vorlage").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Target
Else
MsgBox "Blattname schon vorhanden", vbInformation
End If
End If
End Sub

gruss hary

Anzeige
Auch schön! Jetzt muss sich Armin entscheiden, oT
18.12.2015 12:31:22
Michael

AW: Auch schön! Jetzt muss sich Armin entscheiden, oT
18.12.2015 15:21:18
Armin
ALSO FREUNDE....
ich weiß nicht wie ich mich bedanken soll...echt...vieln vielen dank

AW: Auch schön! Jetzt muss sich Armin entscheiden, oT
18.12.2015 16:06:47
Armin
ALSO FREUNDE....
eine Frage noch..gibt es diese Möglichkeit das man A-Z von einem anderen Blatt kopiert und in die Spalte einfügt und nach dem Bestätigen automatisch die Arbeitstabellen erzeugt werden?

Anzeige
AW: geht auch
19.12.2015 09:41:48
hary
Moin
Bestaetigen brauchst du nix(kann aber eingebaut werden). Es wird von Ausgangsblatt Zeile1 nach Zielblatt B1 kopiert und die Blaetter erstellt. 
Sub Blaetter_erstellen()
Dim wksKop As Worksheet
Dim wksZiel As Worksheet
Dim i As Long
Set wksKop = Worksheets("Tabelle1") '--Blattname anpassen v. hier wird kopiert
Set wksZiel = Worksheets("Tabelle2") '--Blattname anpassen n. hier wird eingefuegt
wksZiel.Columns(2).Clear
wksKop.Range("A1:Z1").Copy
wksZiel.Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=True
For i = 1 To wksZiel.Cells(Rows.Count, 2).End(xlUp).Row
If wksZiel.Cells(i, 2)  "" Then
If IsError(Evaluate(wksZiel.Cells(i, 2) & "!A1")) Then '--hier Pruefung ob Blatt  _
vorhanden
Worksheets("Vorlage").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = wksZiel.Cells(i, 2)
Else
MsgBox "Blattname schon vorhanden", vbInformation
End If
End If
Next
End Sub

gruss hary

Anzeige
AW: Auch schön! Jetzt muss sich Armin entscheiden, oT
21.12.2015 12:12:56
Armin
Eine Frage Noch...besteht diese Möglichkeit, dass nach dem Erzeugen einen neuen Blatt, wenn ich in der Spalte etwas umbenenne, wird das entsprechende Blatt auch umbennant..?

AW: Nachgefragt
21.12.2015 12:55:11
hary
Moin
Also wird von einem Blatt A1:Z1 kopiert und in ein anderes Blatt ab B1:Bxxx und dem entsprechend die Blaetter erstellt.
Jetzt moechtest du wenn du im Bereich B1:Bxxx etwas aenderst das alte Blatt einen neuen Namen geben.
Versteh ich es richtig?
gruss hary

Anzeige
AW: Nachgefragt
22.12.2015 10:40:50
Armin
Holla,
Ja..genau..stell dir vor dass du in der Range("B1") ein Name gibt und dadurch wird ein neues Blatt erstellt, aber dann du siehst oops! du hast dich vertippst und möchtest du den Namen des neu erstellten Blatt ändern ohne ein neues zu erstellen..bzw. wenn du in der Range("B1") einen neuen Name gibt, das neu erstellten Blatt sich auch entsprechend ändert
geht das?

Anzeige
AW: Nachgefragt
22.12.2015 11:32:43
hary
Moin
Die Codes kommen in den Code des Tabellenblattes, in dem du Aenderungen vornimmst. 
Option Explicit
Dim Blattname As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub '--wenn mehr als eine Zelle ausgewaehlt beenden
If Not Intersect(Target, Columns(2)) Is Nothing Then '--wenn SpalteB eine Zelle ausgewaehlt
Blattname = Target '--uebergabe an Variable
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub '--wenn mehr als eine Zelle ausgewaehlt beenden
If Blattname = "" Then Exit Sub '--wenn Variable leer beenden
If Not Intersect(Target, Columns(2)) Is Nothing Then '--gilt fuer gesammte SpalteB
Worksheets(Blattname).Name = Target '--umbenennen
Blattname = "" '--Variable leeren
End If
End Sub

gruss hary
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige