AW: Änderung VBA Code
17.08.2014 20:55:35
Adis
Hallo
vieles ist machbar , probier es einfach aus. Lege ein zweites Modulblatt als Kopie an (zur Vorsicht)
und kopiere das geäenderte Makro ins Modublatt1. Ich habe es getestet, müsste funktionieren.
Die Änderung wurde von mir mit Kommentar dokumentiert, damit man verstehen kann was passiert.
Einige Programmteile sind überflüssig, dann habe ich es mit Kommentar versehen. Viel Spass beim Test.
Sub sbName() 'geäendert von Adis 17.8.2014 für Herber Forum
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim WS As Worksheet
Dim X As Integer
Dim Y As Integer
Set WS = ActiveSheet
For X = 1 To ActiveWorkbook.Worksheets.Count
For Y = X To ActiveWorkbook.Worksheets.Count
If Worksheets(Y).Name 1 Then '1. Blatt Übersichtliste nicht ausfüllen
Sheets(i).Cells(2, 2) = i - 1 'Zelle B2 aendern
Sheets(i).Cells(1, 1) = Sheets(i).Name & " " & i - 1
End If
'Cells(1+2, 1-2) 1 und 2 nur umgetauscht
Cells(i + 2, 2) = Sheets(i).Name
Cells(i + 2, 1) = Sheets(i).Cells(2, 2).Value
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 2, 2), Address:="", SubAddress:= _
"'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
Next 'i
'kann entfallen (oder gekürzt werden) weil Spalte B bereits formatiert ist
'(ist nur sinnvoll als Makro Recorder Aufzeichnung) beim 1. Installieren!)
Columns("B:B").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False 'ab hier kann alles entfallen
.Superscript = False '(Makro Recorder Aufzeichnung)
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
'auf Spalte B geaendert
Columns("B:B").EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.GoTo Reference:="R3C1"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub Löschen()
' Löschen Makro
ActiveSheet.Unprotect
Range("A2:G272").ClearContents '(ohne Selection...)
Range("A4").Select 'auf A4 gesetzt statt C4
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Gruss Adis