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
1244to1248
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

Sheetnamen aus Zellen + neue Sheets

Sheetnamen aus Zellen + neue Sheets
Dieter(Drummer)
Hi VBA Spazialisten,
in der aktuellen Mappe sollen neue Sheets angelegt werden, die aber den Sheetnamen aus der Spalte C - ab inkl. C4 (Text) erhalten. Wenn diese Sheets angelegt sind und neue Namen in Spalte C hinzugefügt werden, sollen neue Sheest hinzugefügt werden. Den Makroauslöser macxhe ich dann per Button.
Wichtig dabei ist, dass vorhandene Sheets NICHT geändert oder gelöscht werden, also immer nur neue hinzugefügt. Es kommt kein Name doppelt vor. Es müsste also bei neuen hinzufügenden Sheets geprüft werden, welche bereits vorhanden sind - im Vergleich zu Spalte C und nur neu hinzugefügte Namen in Spalte C zu neuen Sheets hinzugefügt werden.
Freut mich, wenn ich Hilfe dazu bekomme. Danke für's drum kümmern
Gruß, Dieter(Drummer)

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

Betreff
Benutzer
Anzeige
AW: Habe etwas gefunden aber ...
09.01.2012 13:45:15
Dieter(Drummer)
Hi Spezialisten,
habe dieses Makro gefunden:
  • 
    Sub FuegeBlaetterMitNamenEin() 'Aus Excel Daily
    Dim Bereich As String
    Dim Zelle As Range
    Dim Tabelle As Worksheet
    Bereich = "C4:C27" 'Kann angepasst werden
    With ActiveWorkbook
    For Each Zelle In ActiveSheet.Range(Bereich).Cells
    Set Tabelle = .Sheets.Add(After:=.Sheets(Sheets.Count))
    Tabelle.Name = Zelle.Text
    Next Zelle
    End With
    End Sub
    

  • Es funktioniert auch! Wie muss das Makro sein, dass bei Neuaufruf, wenn neue Namen hinzukommen, die alten NICHT mehr neu angelegt werden?
    Mit der Bitte um Ergänzung des Makros undGruß
    Dieter(Drummer)
    Anzeige
    AW: Habe etwas gefunden aber ...
    09.01.2012 14:13:06
    Tino
    Hallo,
    kannst mal dies versuchen.
    Sub Tabelle_Erstellen()
    Dim rngTabName As Range, rngTmp As Range, strInfo$
    Dim oWS As Worksheet
    
    With Tabelle1 'Tabelle anpassen 
        Set rngTabName = .Range("C4", .Cells(.Rows.Count, 3).End(xlUp))
        If Not Intersect(rngTabName, .Rows("1:3")) Is Nothing Then Exit Sub
    End With
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
            
            With ThisWorkbook
                For Each rngTmp In rngTabName
                    If Not CheckTabelle(rngTmp.Value) Then
                        strInfo = strInfo & rngTmp.Value & vbCr
                        Set oWS = .Sheets.Add(After:=.Sheets(.Sheets.Count))
                        oWS.Name = rngTmp.Value
                    End If
                Next rngTmp
            End With
            
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    If strInfo <> "" Then
        MsgBox "Die Tabelle(n) wurden erstellt!" & vbCr & vbCr & strInfo, vbInformation
    Else
        MsgBox "Es wurden keine Tabellen erstellt!", vbExclamation
    End If
    End Sub
    
    Function CheckTabelle(strTabName$) As Boolean
    On Error Resume Next
    CheckTabelle = Sheets(strTabName).Index > 0
    End Function
    
    Gruß Tino
    Anzeige
    AW: Hervorragend. Funktioniert prima!
    09.01.2012 14:22:24
    Dieter(Drummer)
    Danke Tino,
    klappt hervorragend und ist sehr schnell beim anlegen der Tabellen und "alte" werden nicht überschrieben oder neue erzeugt. Die MsgBox als Hinweis ist auch eine gute Idee.
    Frage: Kann das Makro erweitert werden, dass bei anlegen der Tabelle jeweils in A1, der der Name aus der Zelle, die den Tabellenblattnamen erzeugt hat, eingetragen wird?
    Bitte nur wenn es nicht zu viel Umstände macht, sonst auch ok.
    Danke und Gruß
    Dieter(Drummer
    AW: Hervorragend. Funktioniert prima!
    09.01.2012 14:33:33
    Tino
    Hallo,
    was meinst Du mit "Name aus der Zelle"?
    Soll die Adresse der Zelle oder der enthaltenen Text den auch die Tabelle als Name bekommt in diese Zelle?
    Füge nach der Zeile
    oWS.Name = rngTmp.Value
    noch diese Zeile mit ein.
    'der Text der als Tabellenname verwendet wird
    oWS.Cells(1,1).value = rngTmp.Value
    'oder die Zelleadresse
    oWS.Cells(1,1).value = rngTmp.Address(0, 0)
    Gruß Tino
    Anzeige
    AW: Danke Toni, ganau das war's ...
    09.01.2012 14:40:44
    Dieter(Drummer)
    ... klappt prima ...
    Danke für deine Bemühung. Es funktioniert nach meinen Wünschen undd Vorstellungen.
    Gruß
    Dieter(Drummer)
    AW: @Toni, noch ein Wunsch ...
    09.01.2012 15:00:48
    Dieter(Drummer)
    ... man findet immer noch eine Verbesserungsmöglichkeit.
    habe noch einen Wunsch. Diese/deine Zeile habe ich noch eingefügt und nur auf Spalte 2 angepasst, Funktionert gut.
    Aus der Tabelle,m aus der die Namen gelesen werden und zum Tabellenblattnamen werden ins neben dem Namen in Spalte B eine Ganzahl (1 bis max 3 Stellen). Kannst Du mir evtl noch das Makro erweitern, dass in den neuen Tabellen jeweils die Zahl noch in Spalte 1 davor gesetzt wird? Hoffe es ist nicht zuviel verlangt.
    Es soll also dann im neuen Sheet z. B. so stehen: "120 Name" Ohne Anführungszeichen. Die 120 ist aus Spalte B und kommt dann im neuen Sheet in Spalte A und der tab.name steht dann im neuen Sheet in Spalte C.
    Danke für evtl. Erweiterung und Hilfe.
    Gruß
    Dieter(Drummer)
    Anzeige
    AW: @Toni, Korrektur
    09.01.2012 15:18:47
    Dieter(Drummer)
    ... man findet immer noch eine Verbesserungsmöglichkeit.
    habe noch einen Wunsch. Diese/deine Zeile habe ich noch eingefügt und nur auf Spalte 2 angepasst, Funktionert gut.
    Aus der Tabelle,m aus der die Namen gelesen werden und zum Tabellenblattnamen werden ins neben dem Namen in Spalte B eine Ganzahl (1 bis max 3 Stellen). Kannst Du mir evtl noch das Makro erweitern, dass in den neuen Tabellen jeweils die Zahl noch in Spalte 1 davor gesetzt wird? Hoffe es ist nicht zuviel verlangt.
    Es soll also dann im neuen Sheet z. B. so stehen: "120 Name" Ohne Anführungszeichen. Die 120 ist aus Spalte B und kommt dann im neuen Sheet in Spalte A und der tab.name steht dann im neuen Sheet in Spalte B.
    Danke für evtl. Erweiterung und Hilfe.
    Gruß
    Dieter(Drummer)
    Anzeige
    AW: @Tino Korrektur
    09.01.2012 15:22:47
    Rudi
    Hallo,
    oWS.Cells(1,1).value = rngTmp.OffSet(, 1)
    Gruß
    Rudi
    Tino und nicht Toni !
    09.01.2012 15:25:34
    Tino
    Hallo,
    Dein Text ist sehr schwer zu verstehen, hoffe Dich richtig verstanden zu haben.
    Die For Each Schleife müsste demnach so aussehen.
    For Each rngTmp In rngTabName
        If Not CheckTabelle(rngTmp.Value) Then
            strInfo = strInfo & rngTmp.Value & vbCr
            Set oWS = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            oWS.Name = rngTmp.Value
            'Die Zahl aus Spalte B in die Zelle A1 
            oWS.Range("A1").Value = rngTmp.Offset(0, -1).Value
            'Der Name der Tabelle in Spalte C 
            oWS.Range("C1").Value = rngTmp.Value
        End If
    Next rngTmp
    
    Gruß Tino
    Anzeige
    AW: @Tino!
    09.01.2012 15:32:56
    Dieter(Drummer)
    ... Sory für Toni statt Tino.
    Hier ist dein jetziger Code:
  • 
    Sub Tabelle_Erstellen()
    Dim rngTabName As Range, rngTmp As Range, strInfo$
    Dim oWS As Worksheet
    With Tabelle1 'Tabelle anpassen
    Set rngTabName = .Range("C4", .Cells(.Rows.Count, 3).End(xlUp))
    If Not Intersect(rngTabName, .Rows("1:3")) Is Nothing Then Exit Sub
    End With
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    With ThisWorkbook
    For Each rngTmp In rngTabName
    If Not CheckTabelle(rngTmp.Value) Then '
    
    
    Function von Toni
    strInfo = strInfo & rngTmp.Value & vbCr
    Set oWS = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    oWS.Name = rngTmp.Value
    ' Fügt in A1 den Blattnamen (Titel) ein. Erweiterung von Toni
    oWS.Cells(1, 2).Value = rngTmp.Value
    End If
    Next rngTmp
    End With
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    End With
    If strInfo  "" Then
    MsgBox "Die Tabelle(n) wurden erstellt!" & vbCr & vbCr & strInfo, vbInformation
    Else
    MsgBox "Es wurden keine Tabellen erstellt!", vbExclamation
    End If
    End Sub
    
    'gehört zu Toni
    Function CheckTabelle(strTabName$) As Boolean
    On Error Resume Next
    CheckTabelle = Sheets(strTabName).Index > 0
    End Function
    


  • Wo setze ich jetzt den neuen Code von dir ein, wenn im neuen Sheet, in Spalte A, die Zahl noch mit eingefügt werden soll.
    Danke für weitere Hilfe.
    Gruß
    Dieter(Drummer)
    Anzeige
    AW: Danke Tino. Funktioniert prima!
    09.01.2012 16:25:48
    Dieter(Drummer)
    Vielen Danke Tino für deine Bemühung, es klappt wie gewünscht.
    Gruß und einen schönen Resttag,
    Dieter(Drummer)
    AW: Habe etwas gefunden aber ...
    09.01.2012 14:24:30
    Rudi
    Hallo,
    so:
    Sub FuegeBlaetterMitNamenEin() 'Aus Excel Daily
    Dim Zelle As Range
    Dim Bereich As Range
    Dim Tabelle As Worksheet
    Application.ScreenUpdating = False
    With ActiveSheet
    Set Bereich = .Range(.Cells(4, 3), .Cells(Rows.Count, 3).End(xlUp))
    End With
    For Each Zelle In Bereich.Cells
    Set Tabelle = Nothing
    On Error Resume Next
    Set Tabelle = Worksheets(Zelle.Value)
    On Error GoTo 0
    If Tabelle Is Nothing Then
    Set Tabelle = Sheets.Add(After:=Sheets(Sheets.Count))
    Tabelle.Name = Zelle
    End If
    Next Zelle
    Bereich.Parent.Activate
    End Sub
    

    Gruß
    Rudi
    Anzeige
    AW: Danke Rudi, funktionert auch gut ...
    09.01.2012 14:34:37
    Dieter(Drummer)
    ... würde nur gerne noch in den neuen Tabellen den Namen jeweils in A1 eintragen lassen, wenn es geht.
    habe diesen Wunsch der Erweiterung an Tino schon geschrieben. Tinos Variante ist gut und ich werde wohl diese - evtl. noch mit der Erweiterung - nehmen.
    Danke für deine Hilfe und
    Gruß
    Dieter(Drummer)

    315 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige