Thema Datum  Von Nutzer Rating
Antwort
12.07.2017 22:52:42 Gast12173
NotSolved
Blau dynamische Tabelle und Tabellenblatt Kopieren
13.07.2017 18:58:39 Ben
NotSolved

Ansicht des Beitrags:
Von:
Ben
Datum:
13.07.2017 18:58:39
Views:
477
Rating: Antwort:
  Ja
Thema:
dynamische Tabelle und Tabellenblatt Kopieren

Hallo,

der folgende Code kann hilfreich sein:

Option Explicit

Dim OldWorksheetName As String

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngChk As Range, rngTarget As Range, sSheetName As String
    Dim wsh As Worksheet, wshNew As Worksheet
    With Target.Worksheet
        Set rngChk = .Range(.Range("D10"), .Cells(.UsedRange.Rows.Count + UsedRange.Row, 4))
        For Each rngTarget In Target.Cells
            If Not Intersect(rngTarget, rngChk) Is Nothing Then
                sSheetName = rngTarget.Cells(1, 1).Value
                If sSheetName = "" Then
                    ' gelöscht
                    If Not OldWorksheetName = "" Then
                        Set wshNew = GetWorksheet(ThisWorkbook, OldWorksheetName)
                        If Not wshNew Is Nothing Then
                            Application.DisplayAlerts = False
                            wshNew.Delete
                            Application.DisplayAlerts = True
                            OldWorksheetName = ""
                        End If
                    End If
                Else
                If Not OldWorksheetName = "" Then
                    ' Umbenennen
                    Set wshNew = GetWorksheet(ThisWorkbook, OldWorksheetName)
                    If Not wshNew Is Nothing Then
                        wshNew.Name = sSheetName
                    End If
                Else
                    Set wsh = GetWorksheet(ThisWorkbook, sSheetName)
                    If wsh Is Nothing Then
                        Template.Copy After:=Target.Worksheet
                        Set wshNew = SearchHiddenWorkbook(ThisWorkbook, Template)
                        wshNew.Name = sSheetName
                        wshNew.Visible = xlSheetVisible
                        wshNew.Activate
                    End If
                End If
                End If
            End If
        Next
    End With
End Sub

Private Function SearchHiddenWorkbook(wbk As Workbook, wshTemplate As Worksheet) As Worksheet
    Dim wsh As Worksheet
    For Each wsh In wbk.Worksheets
        If Not wsh.Visible = xlSheetVisible Then
            If Left(wsh.Name, Len(wshTemplate.Name)) = wshTemplate.Name Then
                Set SearchHiddenWorkbook = wsh
                Exit For
            End If
        End If
    Next
End Function

Private Function GetWorksheet(wbk As Workbook, sName As String) As Worksheet
    Dim wsh As Worksheet
    With wbk
        For Each wsh In wbk.Worksheets
            If wsh.Name = sName Then
                Set GetWorksheet = wsh
                Exit For
            End If
        Next
    End With
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngChk As Range, rngTarget As Range
    Dim wsh As Worksheet, wshNew As Worksheet
    With Target.Worksheet
        Set rngChk = .Range(.Range("D10"), .Cells(.UsedRange.Rows.Count + UsedRange.Row, 4))
        For Each rngTarget In Target.Cells
            If Not Intersect(rngTarget, rngChk) Is Nothing Then
                OldWorksheetName = rngTarget.Value
            End If
        Next
    End With
End Sub

Dieser Code muss der  Tabelle zugewiesen werden, in dem in Spalte D die Tabellennamen eingegeben werden sollen.

Zusätzlich muss in der Arbeitmappe eine Tabelle mit dem Namen Template vorhanden sein.

Die Tabelle "Template" dient als Vorlage für die neu erstellen Tabellen.

Einschränkung: Die neu zu erstellenden Tabellen dürfen nicht den Namen Template haben!

Rückfragen einfach hier einstellen.

LG, Ben


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
12.07.2017 22:52:42 Gast12173
NotSolved
Blau dynamische Tabelle und Tabellenblatt Kopieren
13.07.2017 18:58:39 Ben
NotSolved