Microsoft Excel

Herbers Excel/VBA-Archiv

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

Tabellenblätter nach Liste erstellen


Betrifft: Tabellenblätter nach Liste erstellen von: Ansgar
Geschrieben am: 25.09.2019 15:32:14

Hallo Zusammen,

ich erstelle eine Liste aus Namen auf ein Tabellenblatt "Übersicht". Aus dieser Liste wird wiederum eine Datenliste im Tabellenblatt "Daten" erstellt. Es gibt ein Tabellenblatt mit dem Namen "Vorlage".
Auf Knopfdruck wird nun das Tabellenblatt "Vorlage" sooft kopiert wie es Namen in der Liste gibt und auch gleich mit den Namen versehen.

Nun zu meinem Problem:
Nachdem ich einmal die Tabellenblätter nach der Liste erstellt habe, kann ich nach hinzufügen eines neuen namens diese Funktion nicht mehr nutzen. Es kommt logischerweise eine Fehlermeldung.

Hier mein Code: (Funktioniert soweit ganz gut)

Sub Vorlage_kopieren()
  Dim rngZelle    As Range, _
      rngZelle2   As Range, _
      rngBereich  As Range, _
      rngBereich2  As Range, _
      wb          As Workbook, _
      iIndex      As Integer
        
  Set wb = ThisWorkbook
  Set rngBereich = wb.Sheets("Daten").Range("H5:H60")
  Set rngBereich2 = wb.Sheets("Daten").Range("I5:I60")
   iIndex = wb.Sheets("Vorlage").Index
    For Each rngZelle In rngBereich
    If rngZelle <> "" Then
      wb.Sheets("Vorlage").Copy After:=wb.Sheets(iIndex)
      iIndex = iIndex + 1
     ActiveSheet.Name = rngZelle.Value
    End If
  Next rngZelle
  MsgBox "Hast Du schön gemacht"
  Worksheets("Übersicht").Activate
  End Sub

hat einer eine Idee??

  

Betrifft: AW: Tabellenblätter nach Liste erstellen von: UweD
Geschrieben am: 25.09.2019 16:14:29

Hallo

ungetestet...

Sub Vorlage_kopieren()
   Dim rngZelle    As Range, _
      rngZelle2   As Range, _
      rngBereich  As Range, _
      rngBereich2  As Range, _
      wb          As Workbook, _
      iIndex      As Integer
        
   Set wb = ThisWorkbook
   Set rngBereich = wb.Sheets("Daten").Range("H5:H60")
   Set rngBereich2 = wb.Sheets("Daten").Range("I5:I60")
   iIndex = wb.Sheets("Vorlage").Index
      For Each rngZelle In rngBereich
         If rngZelle <> "" Then
            'prüfen ob Blatt schon existiert
            If IsError(Evaluate(rngZelle & "!A1")) Then
               MsgBox "Blatt '" & rngZelle & "' existiert schon"
               Exit sub
            End If
          
            wb.Sheets("Vorlage").Copy After:=wb.Sheets(iIndex)
            iIndex = iIndex + 1
            ActiveSheet.Name = rngZelle.Value
         End If
       Next rngZelle
       MsgBox "Hast Du schön gemacht"
       Worksheets("Übersicht").Activate
End Sub


LG UweD


  

Betrifft: AW: Tabellenblätter nach Liste erstellen von: Ansgar
Geschrieben am: 25.09.2019 16:44:40

Hallo UweD

Danke für die schnelle Reaktion. Leider funktioniert der Code nicht. Es wird sofort die Fehlermeldung Batt "" Existiert schon ausgegeben. Bevor auch nur 1 Tabellenblatt erstellt wurde.

Ich sehe auch gerade, dass ich ein paar Zeilen noch nicht gelöscht hat. rngZelle2 und rngBereich2
Kommt aber keine Fehlermeldung, darum stehen die noch im Code.


  

Betrifft: AW: Tabellenblätter nach Liste erstellen von: UweD
Geschrieben am: 25.09.2019 21:27:26

Lad mal Musterseiten hoch


  

Betrifft: AW: Tabellenblätter nach Liste erstellen von: UweD
Geschrieben am: 26.09.2019 08:33:45

Hallo nochmal


Was 3 Buchstaben ausmachen...


Ich habe das Not vergessen.

Die Zeile muss so heißen.

              If  Not  IsError(Evaluate(rngZelle & "!A1")) Then
LG UweD


  

Betrifft: AW: Tabellenblätter nach Liste erstellen von: Dieter Klemke
Geschrieben am: 25.09.2019 17:24:00

Hallo Ansgar,

ich schlage das folgende Vorgehen vor:

Sub Vorlage_kopieren()
  Dim rngZelle    As Range
  Dim rngZelle2   As Range
  Dim rngBereich  As Range
  Dim rngBereich2 As Range
  Dim wb          As Workbook

  Set wb = ThisWorkbook
  Set rngBereich = wb.Sheets("Daten").Range("H5:H60")
  Set rngBereich2 = wb.Sheets("Daten").Range("I5:I60")
    For Each rngZelle In rngBereich.Cells
      If rngZelle <> "" Then
        ' prüfen, ob Blatt schon existiert
        If Not BlattExistiert(rngZelle.Value) Then
          wb.Sheets("Vorlage").Copy After:=wb.Sheets(wb.Sheets.Count)
          ActiveSheet.Name = rngZelle.Value
        End If
      End If
    Next rngZelle
    MsgBox "Hast Du schön gemacht"
    wb.Worksheets("Übersicht").Activate
 End Sub

Function BlattExistiert(BlattName As String) As Boolean
  Dim sh As Object
  
  For Each sh In ThisWorkbook.Sheets
    If UCase$(BlattName) = UCase$(sh.Name) Then
      BlattExistiert = True
      Exit Function
    End If
  Next sh
End Function

Wenn du deine Liste im Zellbereich Daten!H5:H60 verlängerst, dann werden bei dieser Version die neuen Blätter hinten angefügt. Bei der ursprünglichen Version erscheinen sie direkt hinter dem Blatt "Vorlage".

Viele Grüße
Dieter


  

Betrifft: AW: Tabellenblätter nach Liste erstellen von: Ansgar
Geschrieben am: 26.09.2019 07:28:24

Hallo Dieter,
das funktioniert super. Danke

Danke auch an UweD


Beiträge aus dem Excel-Forum zum Thema "Tabellenblätter nach Liste erstellen"