Tabellenblätter per Knopfdruck

Forumthread: Tabellenblätter per Knopfdruck

24.02.2020 09:42:33

Tim

Hallo zusammen,
ich arbeite aktuell an einer Liste für unsere Kundenmuster.
Nun benötige ich folgende Funktionen per Knopfdruck:
1. Erstellen neuer Tabellenblätter mit fortlaufender Nummerierung (nach der Geräteliste)
2. Automatisches Ausfüllen von Nr., Typ, Seriennummer, Kunde und Ort im neuen Blatt
3. Wenn möglich automatisches verlinken (wie in Zelle H5)
Als Vorlage für die neuen Tabellenblätter dient Blatt "1".
Kann mir da vielleicht jemand eine Formel erstellen.
Ich habe leider noch keine Ahnung, was Makros etc. angeht.
Vielen Dank im Voraus.
https://www.herber.de/bbs/user/135399.xlsm

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabellenblätter per Knopfdruck

24.02.2020 11:27:58

UweD
Update

24.02.2020 12:37:29

UweD

AW: Tabellenblätter per Knopfdruck

24.02.2020 11:27:58

UweD

Hallo
so?

Option Explicit
Sub Schaltfläche1_Klicken()
    Dim TBG  As Worksheet, TB1  As Worksheet, TBx As Worksheet
    Dim NeuName As String, LR As Integer
    
    Set TBG = Sheets("Geräteübersicht")
    Set TB1 = Sheets("1")
        
    'Neue Nummer 
    NeuName = WorksheetFunction.Max(TBG.Columns(1)) + 1
    
    ' **Neue Zeile 
    LR = TBG.Cells(TBG.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 

    '**Prüfen ob Blatt schon da 
    If IsError(Evaluate(NeuName & "!A1")) Then
        'Nein, neues Blatt anlegen 
        TB1.Copy After:=Sheets(Sheets.Count)
        Set TBx = ActiveSheet
        

        With TBx
            '**benennen 
            .Name = NeuName
        
            '**Neue Nummer in Übersicht einfügen 
            TBG.Cells(LR + 1, 1) = NeuName
        
            '**Link in Übersicht einfügen 
            TBG.Hyperlinks.Add Anchor:=TBG.Cells(LR + 1, 8), Address:="", SubAddress:= _
                "'" & NeuName & "'!A1", TextToDisplay:="'" & NeuName & "'!A1"
            
            '**Formeln einfügen 
            .Cells(3, 1).Resize(1, 2).FormulaR1C1 = "=" & TBG.Name & "!R" & LR + 1 & "C"
            .Cells(3, 3).Resize(1, 3).FormulaR1C1 = "=" & TBG.Name & "!R" & LR + 1 & "C[1]"
            
        
        End With
    Else
        MsgBox NeuName & ": existiert bereits"
        
    End If
End Sub

LG UweD

Update

24.02.2020 12:37:29

UweD

Hallo nochmal
hab gerade gesehen, da sind ja noch weitere Verbundene Zellen.
Also Formelzuweisung in 3 Schritten

Option Explicit
Sub Schaltfläche1_Klicken()
    Dim TBG  As Worksheet, TB1  As Worksheet, TBx As Worksheet
    Dim NeuName As String, LR As Integer
    
    Set TBG = Sheets("Geräteübersicht")
    Set TB1 = Sheets("1")
        
    'Neue Nummer 
    NeuName = WorksheetFunction.Max(TBG.Columns(1)) + 1
    
    ' **Neue Zeile 
    LR = TBG.Cells(TBG.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 

    '**Prüfen ob Blatt schon da 
    If IsError(Evaluate(NeuName & "!A1")) Then
        'Nein, neues Blatt anlegen 
        TB1.Copy After:=Sheets(Sheets.Count)
        Set TBx = ActiveSheet
        

        With TBx
            '**benennen 
            .Name = NeuName
        
            '**Neue Nummer in Übersicht einfügen 
            TBG.Cells(LR + 1, 1) = NeuName
        
            '**Link in Übersicht einfügen 
            TBG.Hyperlinks.Add Anchor:=TBG.Cells(LR + 1, 8), Address:="", SubAddress:= _
                "'" & NeuName & "'!A1", TextToDisplay:="'" & NeuName & "'!A1"
            
            'GGF **Neue Zeile ergänzen 
            TBG.Rows(LR + 2).Copy
            TBG.Rows(LR + 2).Insert xlDown
            Application.CutCopyMode = False

            
            '**Formeln einfügen 
            .Cells(3, 1).Resize(1, 2).FormulaR1C1 = "=" & TBG.Name & "!R" & LR + 1 & "C"
            .Cells(3, 3).Resize(1, 1).FormulaR1C1 = "=" & TBG.Name & "!R" & LR + 1 & "C[1]"
            .Cells(3, 4).Resize(1, 2).FormulaR1C1 = "=" & TBG.Name & "!R" & LR + 1 & "C[2]"
        
        End With
    Else
        MsgBox NeuName & ": existiert bereits"
        
    End If
End Sub

LG UweD

Beliebteste Forumthreads (12 Monate)

Forumthread: Tabellenblätter per Knopfdruck

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread