Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Sheetnamen aus Zellen + neue Sheets | Herbers Excel-Forum


Betrifft: Sheetnamen aus Zellen + neue Sheets von: Dieter(Drummer)
Geschrieben am: 09.01.2012 12:35:06

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)

  

Betrifft: AW: Habe etwas gefunden aber ... von: Dieter(Drummer)
Geschrieben am: 09.01.2012 13:45:15

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)


      

    Betrifft: AW: Habe etwas gefunden aber ... von: Tino
    Geschrieben am: 09.01.2012 14:13:06

    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


      

    Betrifft: AW: Hervorragend. Funktioniert prima! von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 14:22:24

    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


      

    Betrifft: AW: Hervorragend. Funktioniert prima! von: Tino
    Geschrieben am: 09.01.2012 14:33:33

    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


      

    Betrifft: AW: Danke Toni, ganau das war's ... von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 14:40:44

    ... klappt prima ...

    Danke für deine Bemühung. Es funktioniert nach meinen Wünschen undd Vorstellungen.

    Gruß
    Dieter(Drummer)


      

    Betrifft: AW: @Toni, noch ein Wunsch ... von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 15:00:48

    ... 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)


      

    Betrifft: AW: @Toni, Korrektur von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 15:18:47

    ... 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)


      

    Betrifft: AW: @Tino Korrektur von: Rudi Maintaire
    Geschrieben am: 09.01.2012 15:22:47

    Hallo,
    oWS.Cells(1,1).value = rngTmp.OffSet(, 1)

    Gruß
    Rudi


      

    Betrifft: Tino und nicht Toni ! von: Tino
    Geschrieben am: 09.01.2012 15:25:34

    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


      

    Betrifft: AW: @Tino! von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 15:32:56

    ... 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)


      

    Betrifft: AW: @Tino! Hier eine Musterdatei von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 15:48:43

    ... evtl. ist das verständlicher ...

    https://www.herber.de/bbs/user/78320.xls

    Gruß
    Dieter(Drummer)


      

    Betrifft: AW: @Tino! Hier eine Musterdatei von: Tino
    Geschrieben am: 09.01.2012 16:12:36

    Hallo,
    sollte so funktionieren.

    https://www.herber.de/bbs/user/78322.xls

    Gruß Tino


      

    Betrifft: AW: Danke Tino. Funktioniert prima! von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 16:25:48

    Vielen Danke Tino für deine Bemühung, es klappt wie gewünscht.

    Gruß und einen schönen Resttag,
    Dieter(Drummer)


      

    Betrifft: AW: Habe etwas gefunden aber ... von: Rudi Maintaire
    Geschrieben am: 09.01.2012 14:24:30

    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


      

    Betrifft: AW: Danke Rudi, funktionert auch gut ... von: Dieter(Drummer)
    Geschrieben am: 09.01.2012 14:34:37

    ... 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)


    Beiträge aus den Excel-Beispielen zum Thema "Sheetnamen aus Zellen + neue Sheets"