Option Explicit
Sub Worksheets_ermitteln() '----------------< Worksheets_ermitteln() >------------ '< init > Dim wb As Workbook Set wb = ActiveWorkbook Dim wsAusgabe As Worksheet Set wsAusgabe = wb.ActiveSheet '</ init >
Application.Calculation = xlCalculationManual Application.ScreenUpdating = False
'----< @Loop: Worksheets >---- Dim ws As Worksheet Dim iSheet As Integer iSheet = 0
For Each ws In wb.Worksheets iSheet = iSheet + 1 Dim iZeile As Integer iZeile = iSheet + 5 Dim sName As String sName = ws.Name
Application.StatusBar = Now & " " & iSheet & " " & sName
wsAusgabe.Range("C" & iZeile).Value = iSheet wsAusgabe.Range("D" & iZeile).Value = sName wsAusgabe.Range("E" & iZeile).Value = ws.Index Next '----</ @Loop: Worksheets >---- Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic
MsgBox "Fertig " '----------------</ Worksheets_ermitteln() >------------ End Sub |