Arbeitsblatt

Sub Makro1() Dim StrSheetname As String StrSheetname = InputBox("Wechseln zu Blatt-Name:", , StrSheetname) Sheets(StrSheetname).Select If strFind = "" Then GoTo Exit_BlattSuche Exit_BlattSuche: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Exit Sub End Sub wie muß der Code geändert werden, wenn ich alle Arbeitsblätter die eine 15 in ihrem Namen _ haben in der Registerleiste vorne Platziert haben will. im Voraus vielen Dank mit freundlichen Grüßen Uli

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Ulrich,
dein Code sucht gar nicht, er aktiviert nur eine vorher per Namen angegebene Tabelle, der Rest des Codes ist nonsense.
Probier mal.

' **********************************************************************
' Modul: Modul2  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub sortSheets15()
  Dim objSh As Worksheet
  Dim vntToSort() As Variant
  Dim lngIndex As Long
  
  For Each objSh In ThisWorkbook.Worksheets
    If objSh.Name Like "*15*" Then
      Redim Preserve vntToSort(lngIndex)
      vntToSort(lngIndex) = objSh.Name
      lngIndex = lngIndex + 1
    End If
  Next
  
  If lngIndex > 0 Then
    QuickSort vntToSort
    For lngIndex = 0 To UBound(vntToSort)
      Sheets(vntToSort(lngIndex)).Move Before:=Sheets(1)
    Next
  End If
End Sub


Sub QuickSort(data() As Variant, Optional UG, Optional OG)
  Dim P1&, P2&, T1 As Variant, T2 As Variant
  
  UG = IIf(IsMissing(UG), LBound(data), UG)
  OG = IIf(IsMissing(OG), UBound(data), OG)
  
  P1 = UG
  P2 = OG
  T1 = data((P1 + P2) / 2)
  
  Do
    
    Do While (data(P1) < T1)
      P1 = P1 + 1
    Loop
    
    Do While (data(P2) > T1)
      P2 = P2 - 1
    Loop
    
    If P1 <= P2 Then
      T2 = data(P1)
      data(P1) = data(P2)
      data(P2) = T2
      P1 = P1 + 1
      P2 = P2 - 1
    End If
    
  Loop Until (P1 > P2)
  
  If UG < P2 Then QuickSort data, UG, P2
  If P1 < OG Then QuickSort data, P1, OG
  
End Sub

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Arbeitsblatt

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread