Microsoft Excel

Herbers Excel/VBA-Archiv

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

Tabellenblätter erstellen mit Makro danach einlese | Herbers Excel-Forum


Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 17.01.2012 21:23:42

Hallo!

ich scheitere gerade...

Ich benötige ein makro das folgendes Macht (change Ereignis ich weiss - aber ich schaff's nicht alleine)

Folgende Tabellen gibt es:

Tabelle "Auswertungen"
Tabelle "Mustererhebungsblatt"

wenn im Tabellenblatt "Auswertungen" in Zellen A6 bis A200 etwas eingetragen wird (Z.B. Hr. Meier) dann soll das Tabellenblatt "Mustererhebungsblatt" kopiert werden und den Namen Hr. Meier erhalten

Sobald eine bereits beschriebene Zelle in A6 bis A200 wieder gelöscht wird soll das dazupassende Tabellenblatt (Z.B. Hr. Meier) wieder gelöscht werden

  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Josef Ehrensberger
Geschrieben am: 17.01.2012 22:04:16


Hallo Thomas,

teste mal.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim objSh As Worksheet, objNew As Worksheet, rng As Range
  Dim strMsg As String
  
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  If Not Intersect(Target, Range("A6:A200")) Is Nothing Then
    For Each objSh In ThisWorkbook.Worksheets
      Select Case objSh.Name
        Case "Auswertungen", "Mustererhebungsblatt" 'Tabellen die nicht gelöscht werden sollen
        Case Else
          If IsError(Application.Match(objSh.Name, Me.Range("A6:A200"), 0)) Then objSh.Delete
      End Select
    Next
    
    For Each rng In Me.Range("A6:A200")
      If rng <> "" Then
        If IsValidSheetName(rng.Text) Then
          If Not SheetExist(rng.Text) Then
            Sheets("Mustererhebungsblatt").Copy After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = rng.Text
            Me.Hyperlinks.Add Anchor:=rng, Address:="", SubAddress:="'" & rng.Text & "'!A1"
          End If
        Else
          strMsg = strMsg & rng.Text & vbLf
        End If
      End If
    Next
    sortSheets ThisWorkbook
    Sheets("Mustererhebungsblatt").Move After:=Sheets(1)
    Me.Move Before:=Sheets(1)
    Me.Range("A6:A200").Sort Key1:=Me.Range("A6"), Order1:=xlAscending, Header:=xlNo
    If Len(strMsg) Then
      MsgBox "Ungültige Blattnamen!" & vbLf & vbLf & _
        "Folgende Tabellen konnte nicht erstellt werden!" & vbLf & _
        vbLf & strMsg, vbInformation, "Hinweis"
    End If
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'Worksheet_Change'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Tabelle1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set objSh = Nothing
  Set objNew = Nothing
  Set rng = Nothing
End Sub


Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Private Function IsValidSheetName(ByVal strName As String) As Boolean
  Dim objRegExp As Object
  
  Set objRegExp = CreateObject("vbscript.regexp")
  
  With objRegExp
    .Global = True
    .Pattern = "^[^\/\\:\*\?\[\]]{1,31}$"
    .IgnoreCase = True
    IsValidSheetName = .test(strName)
  End With
  
  Set objRegExp = Nothing
  
End Function


Private Sub sortSheets(WBook As Workbook, Optional Order As XlSortOrder = xlAscending, Optional AlphaNumeric As Boolean = True)
  Dim lngA As Integer, lngB As Integer
  Dim objActive As Object
  
  Set objActive = ActiveSheet
  
  With WBook
    For lngA = 1 To .Sheets.Count
      For lngB = 1 To .Sheets.Count - 1
        If Format(UCase$(.Sheets(lngB + IIf(Order = xlAscending, 0, 1)).Name), _
          IIf(AlphaNumeric, String(32, "0"), "@")) > Format(UCase$(.Sheets(lngB + _
          IIf(Order = xlAscending, 1, 0)).Name), IIf(AlphaNumeric, _
          String(32, "0"), "@")) Then
          .Sheets(lngB).Move After:=.Sheets(lngB + 1)
        End If
      Next
    Next
  End With
  
  objActive.Activate
  
End Sub






« Gruß Sepp »



  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 00:18:23

Hallo Sepp!!

Erstens bin ich beeindruckt wieviel hier notwendig ist... das hätte ich alleine sowieso nie zusammengebracht

Ich hab's getestet und folgendes herausgefunden:

Erstens die Grundfunktion funkioniert wahnsinnig genial!
Zweitens die Idee mit dem Link ist Spitze - ich hab in das "Mustererhebungsblatt" jetzt noch eine Link "wieder zurück" erstellt, jetzt ist es perfekt!

Ich hab gerade versucht ein paar Änderungen anzubringen, ist mir aber nicht gelungen:

Die Sortierung ist super - es sollen aber die "neuen" sheets erst "nach" dem 6 Sheet (3 Sheets und 3 Diagramme) beginnen, sonst wirds unübersichtlich...

und falls ich in A6 "A" eingebe macht er mir ein Tabellenblatt mit dem namen "A" soweit so perfekt, wenn ich in A7 nochmals "A" eingebe erstellt er kein neues Tabellenblatt und gibt auch keine Fehlermeldung aus, hier wäre es gut wenn die Fehlermeldung kommt, dass es dieses Tabellenblatt schon gibt und er den Wert gar nicht erst in der Zelle stehen lässt?

aber wie gesagt - die Grundfunktion funktioniert sensationell!


  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Josef Ehrensberger
Geschrieben am: 18.01.2012 00:33:29


Hallo Thomas,

kein Problem.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim objSh As Worksheet, objNew As Worksheet, rng As Range
  Dim strMsg As String
  
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  If Not Intersect(Target, Range("A6:A200")) Is Nothing Then
    For Each objSh In ThisWorkbook.Worksheets
      Select Case objSh.Name
        Case "Auswertungen", "Mustererhebungsblatt", "Tabelle21", "Tabelle22", "Tabelle23", "Tabelle24" 'Tabellen die nicht gelöscht werden sollen
        Case Else
          If IsError(Application.Match(objSh.Name, Me.Range("A6:A200"), 0)) Then objSh.Delete
      End Select
    Next
    
    For Each rng In Me.Range("A6:A200")
      If rng <> "" Then
        If IsValidSheetName(rng.Text) Then
          If Not SheetExist(rng.Text) Then
            Sheets("Mustererhebungsblatt").Copy After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = rng.Text
            Me.Hyperlinks.Add Anchor:=rng, Address:="", SubAddress:="'" & rng.Text & "'!A1"
          Else
            If Application.CountIf(Me.Range("A6:A200"), rng) > 1 Then rng = ""
          End If
        Else
          strMsg = strMsg & rng.Text & vbLf
        End If
      End If
    Next
    Me.Activate
    sortSheets ThisWorkbook, , , 7 'ab dem 7. Blatt sortieren
    Me.Range("A6:A200").Sort Key1:=Me.Range("A6"), Order1:=xlAscending, Header:=xlNo
    If Len(strMsg) Then
      MsgBox "Ungültige Blattnamen!" & vbLf & vbLf & _
        "Folgende Tabellen konnte nicht erstellt werden!" & vbLf & _
        vbLf & strMsg, vbInformation, "Hinweis"
    End If
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'Worksheet_Change'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Tabelle1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set objSh = Nothing
  Set objNew = Nothing
  Set rng = Nothing
End Sub


Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Private Function IsValidSheetName(ByVal strName As String) As Boolean
  Dim objRegExp As Object
  
  Set objRegExp = CreateObject("vbscript.regexp")
  
  With objRegExp
    .Global = True
    .Pattern = "^[^\/\\:\*\?\[\]]{1,31}$"
    .IgnoreCase = True
    IsValidSheetName = .test(strName)
  End With
  
  Set objRegExp = Nothing
  
End Function


Private Sub sortSheets(WBook As Workbook, Optional Order As XlSortOrder = xlAscending, Optional AlphaNumeric As Boolean = True, Optional StartIndex As Long = 1)
  Dim lngA As Integer, lngB As Integer
  Dim objActive As Object
  
  If StartIndex >= WBook.Sheets.Count Then Exit Sub
  
  Set objActive = ActiveSheet
  
  With WBook
    For lngA = StartIndex To .Sheets.Count
      For lngB = StartIndex To .Sheets.Count - 1
        If Format(UCase$(.Sheets(lngB + IIf(Order = xlAscending, 0, 1)).Name), _
          IIf(AlphaNumeric, String(32, "0"), "@")) > Format(UCase$(.Sheets(lngB + _
          IIf(Order = xlAscending, 1, 0)).Name), IIf(AlphaNumeric, _
          String(32, "0"), "@")) Then
          .Sheets(lngB).Move After:=.Sheets(lngB + 1)
        End If
      Next
    Next
  End With
  
  objActive.Activate
  
End Sub






« Gruß Sepp »



  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 08:32:41

und jetzt stehe ich vor einem ganz anderen Problem....

Gestern hat Dein Makro noch super funktioniert, heute nicht mehr? aber auch eines der Makros das ich in einem der Tabellenblätter habe hat schon funktioniert (update des Pfades zur Datei sobald die Datei geöffnet wird) und auch das funktioniert nicht mehr, wie wenn Makros die "automatisch" ablaufen nicht mehr funktionieren, falls ich nämlich ein makro aus einem der Sheets über einen Button starte läuft das gleiche makro dass beim öffnen nicht läuft problemlos?

Kann sein dass irgendetwas "deaktiviert" ist oder soähnlich?


  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 09:09:08

so und jetzt hab ich ein anderes problem, das Makro ist zwischendurch unterbrochen worden (ich hab ein bisschen andere tabellenblattnamen und vergessen sie in Deinem makro zu ändern bevor ich gestartet bin!

Jetzt aktualisieren sich die formeln nicht mehr und die makros die beim Öffnen des Workbooks laufen sollten laufen auch nicht, das hat sicher etwas mit screen update oder soähnlich zu tun, nur wie bekomm ich das wieder auf "normal" also "ein" ? dann klappt es nämlich...


  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 09:29:27

ok, mein Fehler, das Problem mit dem nichtautomatischen berechnen hab ich recht einfach gelöst....

damit funktioniert die Sortierfunktion sensationell, danke Sepp!

Ein Thema jetzt noch, falls ein name doppelt eingegeben wird, geschieht folgendes

Die Namen in A6ff rutschen eine Zeile nach unten und oben wird eine "leerzeile" hineinsortiert - wenn man das noch abstellt und stattdessen eine "Fehlermeldung" mit dem Hinweis dass es diesen Namen schon gibt aufpoppt wäre es perfekt!

danke jedenfalls auch jetzt schon!!!!


  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Josef Ehrensberger
Geschrieben am: 18.01.2012 16:00:16


Hallo Thomas,

tausche dein Next-Teil aus.

For Each rng In Intersect(Target, Me.Range("A6:A200"))
  If rng <> "" Then
    If IsValidSheetName(rng.Text) Then
      If Not SheetExist(rng.Text) Then
        Sheets("Mustererhebungsblatt").Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = rng.Text
        Me.Hyperlinks.Add Anchor:=rng, Address:="", SubAddress:="'" & rng.Text & "'!A1"
      Else
        If Application.CountIf(Me.Range("A6:A200"), rng) > 1 Then
          MsgBox "Der Name '" & rng.Text & "' ist schon vorhanden!"
          rng = ""
        End If
      End If
    Else
      strMsg = strMsg & rng.Text & vbLf
    End If
  End If
Next





« Gruß Sepp »



  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 23:43:57

Hallo Sepp!

Es ärgert mich so! Ich versteh's nicht wie und warum es so funktioniert wie's geht - aber jetzt passiert folgendes

Bei einer Doppeleingabe erscheint das Fenster mit der Fehlermeldung - super!
die Fehlerhafte Eingabe wird auch wieder gelöscht - super

Allerdings rutschen jetzt alle vorhergehenden Namen eine Zeile nach unten - aber nicht immer... versteh ich schon gar nicht

kann man nicht sagen: beginne mit dem ersten Namen immer in Zelle A1- auch nachdem etwas doppelt eingegeben wurde?

... danke!


  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 23:43:58

Hallo Sepp!

Es ärgert mich so! Ich versteh's nicht wie und warum es so funktioniert wie's geht - aber jetzt passiert folgendes

Bei einer Doppeleingabe erscheint das Fenster mit der Fehlermeldung - super!
die Fehlerhafte Eingabe wird auch wieder gelöscht - super

Allerdings rutschen jetzt alle vorhergehenden Namen eine Zeile nach unten - aber nicht immer... versteh ich schon gar nicht

kann man nicht sagen: beginne mit dem ersten Namen immer in Zelle A1- auch nachdem etwas doppelt eingegeben wurde?

... danke!


  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 23:44:14

Hallo Sepp!

Es ärgert mich so! Ich versteh's nicht wie und warum es so funktioniert wie's geht - aber jetzt passiert folgendes

Bei einer Doppeleingabe erscheint das Fenster mit der Fehlermeldung - super!
die Fehlerhafte Eingabe wird auch wieder gelöscht - super

Allerdings rutschen jetzt alle vorhergehenden Namen eine Zeile nach unten - aber nicht immer... versteh ich schon gar nicht

kann man nicht sagen: beginne mit dem ersten Namen immer in Zelle A1- auch nachdem etwas doppelt eingegeben wurde?

... danke!


  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Josef Ehrensberger
Geschrieben am: 18.01.2012 23:51:10


Hallo Thomas,

also das "runterrutschen" kann ich nicht nachvollziehen und auch nicht reproduzieren. Gibst du anstatt eine Namen zu löschen etwa ein Leerzeichen ein?

Und diesen Satz verstehe ich gar nicht.

"kann man nicht sagen: beginne mit dem ersten Namen immer in Zelle A1- auch nachdem etwas doppelt eingegeben wurde?"



« Gruß Sepp »



  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 19.01.2012 09:54:13

Hallo Sepp!

adRunterrutschen: Nein gebe ich nicht ein, aber es scheint so als ob dort tatsächlich ein leerzeichen drin ist, wenn ich nämlich NACH dem Runterrutschen die oberste (leere) Zeile markiere und auf entfernen drücke läuft das makro und entfernt die zeile und die anderen rutschen nach oben (danach passt also alles wieder...)

aber zu dem Zeitpunkt als diese "scheinbaren" Leerzeilen drin sind werden aber KEINE Worksheets dazu erstellt, da sind nur diejenigen deren Namen korrekt sind

versteh ich nicht.... woran könnte das liegen?

lg Thomas


  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Josef Ehrensberger
Geschrieben am: 19.01.2012 10:08:23


Hallo Thomas,

kannst du deine Datei hochladen?




« Gruß Sepp »



  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 19.01.2012 12:23:58

Hallo Sepp!

Ich hab eine Zip Datei mit den "Beiden" Dateien die insgesamt notwendig sind, ich hoffe das passt so?

https://www.herber.de/bbs/user/78517.zip


danke nochmals und lg Thomas


  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Josef Ehrensberger
Geschrieben am: 19.01.2012 12:39:36


Hallo Thomas,

wozu brauche ich die zweite Datei?

Warum hast du meine Code-Änderungen nicht übernommen?

Anbei der komplette Code für das Tabellenmodul, die Sortierung habe ich auskommentiert.

' **********************************************************************
' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim objSh As Worksheet, objNew As Worksheet, rng As Range
  Dim strMsg As String
  
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  If Not Intersect(Target, Range("A6:A200")) Is Nothing Then
    For Each objSh In ThisWorkbook.Worksheets
      Select Case objSh.Name
        Case "Auswertung Kalenderstudie", "Mustererhebungsblatt", "ABC", "AD vs Office", "B-Grund", "Basisdaten" 'Tabellen die nicht gelöscht werden sollen
        Case Else
          If IsError(Application.Match(objSh.Name, Me.Range("A6:A200"), 0)) Then objSh.Delete
      End Select
    Next
    
    For Each rng In Intersect(Target, Me.Range("A6:A200"))
      If rng <> "" Then
        If IsValidSheetName(rng.Text) Then
          If Not SheetExist(rng.Text) Then
            Sheets("Mustererhebungsblatt").Copy After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = rng.Text
            Me.Hyperlinks.Add Anchor:=rng, Address:="", SubAddress:="'" & rng.Text & "'!A1"
          Else
            If Application.CountIf(Me.Range("A6:A" & rng.Row), rng) > 1 Then
              MsgBox "Der Name '" & rng.Text & "' ist schon vorhanden!"
              rng = ""
            End If
          End If
        Else
          strMsg = strMsg & rng.Text & vbLf
        End If
      End If
    Next
    Me.Activate
    sortSheets ThisWorkbook, , , 7 'ab dem 7. Blatt sortieren
    'Me.Range("A6:A200").Sort Key1:=Me.Range("A6"), Order1:=xlAscending, Header:=xlNo
    If Len(strMsg) Then
      MsgBox "Ungültige Blattnamen!" & vbLf & vbLf & _
        "Folgende Tabellen konnte nicht erstellt werden!" & vbLf & _
        vbLf & strMsg, vbInformation, "Hinweis"
    End If
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'Worksheet_Change'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Tabelle1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set objSh = Nothing
  Set objNew = Nothing
  Set rng = Nothing
End Sub



Private Function SheetExist(ByVal sheetName As String, Optional wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If wb Is Nothing Then Set wb = ThisWorkbook
  For Each wks In wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function



Private Function IsValidSheetName(ByVal strName As String) As Boolean
  Dim objRegExp As Object
  
  Set objRegExp = CreateObject("vbscript.regexp")
  
  With objRegExp
    .Global = True
    .Pattern = "^[^\/\\:\*\?\[\]]{1,31}$"
    .IgnoreCase = True
    IsValidSheetName = .test(strName)
  End With
  
  Set objRegExp = Nothing
  
End Function



Private Sub sortSheets(WBook As Workbook, Optional Order As XlSortOrder = xlAscending, Optional AlphaNumeric As Boolean = True, Optional StartIndex As Long = 1)
  Dim lngA As Integer, lngB As Integer
  Dim objActive As Object
  
  If StartIndex >= WBook.Sheets.Count Then Exit Sub
  
  Set objActive = ActiveSheet
  
  With WBook
    For lngA = StartIndex To .Sheets.Count
      For lngB = StartIndex To .Sheets.Count - 1
        If Format(UCase$(.Sheets(lngB + IIf(Order = xlAscending, 0, 1)).Name), _
          IIf(AlphaNumeric, String(32, "0"), "@")) > Format(UCase$(.Sheets(lngB + _
          IIf(Order = xlAscending, 1, 0)).Name), IIf(AlphaNumeric, _
          String(32, "0"), "@")) Then
          .Sheets(lngB).Move After:=.Sheets(lngB + 1)
        End If
      Next
    Next
  End With
  
  objActive.Activate
  
End Sub






« Gruß Sepp »



  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 19.01.2012 13:54:52

Hallo Sepp!

Sorry, ich hab dir versehentlich nicht die "letztversion" der Datei gesendet, deswegen war die änderung nicht drin!- und die Zweite Datei brauchst Du gar nicht, die ist für das zweite Makro.... (funktioniert auch noch nicht....)

Jedenfalls grossen Dank nochmals - läuft jetzt perfekt, so wie ich es wollte!

Beim Testen soeben ist mir nur noch eingefallen noch perfekter wäre es wenn die neu generierten Tabellenblätter immer in der gleichen Reihenfolge sind wie die Namen in A6ff.
- falls nach dem Erstellen jemand die Reihenfolge der Namen ändert macht es natürlich auch Sinn dass die dazupassenen Tabellenblätter in der gleichen Reihenfolge sind...

oder geht "sortieren" nach einer bestimten Liste gar nicht?

Jedenfalls bin ich sehr froh, dass Du mir geholfen hast!

liebe Grüße!

Thomas


  

Betrifft: AW: Tabellenblätter erstellen mit Makro danach einlese von: Josef Ehrensberger
Geschrieben am: 19.01.2012 14:21:17


Hallo Thomas,

würde schon gehen, ist aber eher aufwändig, vor allem, wenn die Namen verschoben werden.




« Gruß Sepp »



  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 20.01.2012 14:22:42

Egal, danke jedenfalls es funktioniert perfekt!
lg Thomas


  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 23:44:59

Hallo Sepp!

Es ärgert mich so! Ich versteh's nicht wie und warum es so funktioniert wie's geht - aber jetzt passiert folgendes

Bei einer Doppeleingabe erscheint das Fenster mit der Fehlermeldung - super!
die Fehlerhafte Eingabe wird auch wieder gelöscht - super

Allerdings rutschen jetzt alle vorhergehenden Namen eine Zeile nach unten - aber nicht immer... versteh ich schon gar nicht

kann man nicht sagen: beginne mit dem ersten Namen immer in Zelle A1- auch nachdem etwas doppelt eingegeben wurde?

... danke!


  

Betrifft: schalte evtl. die Ereignisse erst mal wieder ein von: Matthias L
Geschrieben am: 18.01.2012 09:29:29

Hallo

lass mal den Code laufen

Sub thomas()
  With Application
  MsgBox "jetziger Status:" & vbLf & vbLf & "ScreenUpdating = " & .ScreenUpdating & vbLf & " _
EnableEvents = " & .EnableEvents
    .ScreenUpdating = True
    .EnableEvents = True
    MsgBox "Status nach Code:" & vbLf & vbLf & "ScreenUpdating = " & .ScreenUpdating & vbLf & " _
EnableEvents = " & .EnableEvents
  End With
End Sub


Übrigens hatte ich auch weitergebalstelt.
Auch wenn Du Sepp sein Beispiel verwendest kannst Du ja trotzdem mal reinschauen.
https://www.herber.de/bbs/user/78481.xls

Gruß Matthias


  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 09:38:09

hallo Mathias!

Super danke !
Das mit dem Sceenupdating hab ich einfach in Optionen/Berechnung wieder "angehakt" hat gleich wieder funktionert...
Deine version oben funktioniert auch sehr gut!

Sepp's Möglichkeit die werte gleich Alphabetisch zu sortieren, die Tabellen ebenso ist eine Sache (wobei ich nicht weiss ob's nicht auch verkehrt sein kann, aber das wird sich beim Anwenden herausstellen!

und dann würde bei Dir noch die funktion fehlen die Tabellenblätter wieder zu löschen wenn man die Zellen in A6ff löscht... abgesehen davon ist Dein code natürlich viel kürzer und so - zum teil - auch für mich als VBA Anfänger halbwegs zu durchschauen, da tu ich mir bei Sepp's version viel schwerer, wenn auch die Prüfung nach ungültigen Namen schon genial ist.....

Also danke jedenfalls, ich hätt eh noch ein thema offen... das mit dem Einlesen der Daten aus den Dateien.... ich weiss unverschämt.....


  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 09:38:18

hallo Mathias!

Super danke !
Das mit dem Sceenupdating hab ich einfach in Optionen/Berechnung wieder "angehakt" hat gleich wieder funktionert...
Deine version oben funktioniert auch sehr gut!

Sepp's Möglichkeit die werte gleich Alphabetisch zu sortieren, die Tabellen ebenso ist eine Sache (wobei ich nicht weiss ob's nicht auch verkehrt sein kann, aber das wird sich beim Anwenden herausstellen!

und dann würde bei Dir noch die funktion fehlen die Tabellenblätter wieder zu löschen wenn man die Zellen in A6ff löscht... abgesehen davon ist Dein code natürlich viel kürzer und so - zum teil - auch für mich als VBA Anfänger halbwegs zu durchschauen, da tu ich mir bei Sepp's version viel schwerer, wenn auch die Prüfung nach ungültigen Namen schon genial ist.....

Also danke jedenfalls, ich hätt eh noch ein thema offen... das mit dem Einlesen der Daten aus den Dateien.... ich weiss unverschämt.....


  

Betrifft: wieso geht das Löschen nicht ? von: Matthias L
Geschrieben am: 18.01.2012 11:30:06

Hallo

Zitat
und dann würde bei Dir noch die funktion fehlen die Tabellenblätter wieder zu löschen wenn man die Zellen in A6ff löscht...


Ich habe doch sogar eine Abfrage mit drin ob Du wirklich das entsprechende Blatt löschen willst



In A9 stand Matthias, durch drücken der Taste Entf. kommt die Abfrage
Bei Ja wird das Blatt [Matthias] gelöscht
Bein Nein wird der aus der Zelle entfernte Name wieder eingetragen (siehe Undo)

Gruß Matthias


  

Betrifft: Tabellenblätter erstellen mit Makro danach einlese von: Thomas Windbüchler
Geschrieben am: 18.01.2012 17:21:05

hmm, ich weiss es nicht warum das bei mir nicht geht, kann es sein, weil in meinem workbook noch andere Sheets auch sind?


Beiträge aus den Excel-Beispielen zum Thema "Tabellenblätter erstellen mit Makro danach einlese"