ich habe folgende u.a. Codes. Ich möchte nun, dass diese Codes als ein Makro ablaufen. Aber nicht als Worksheet_Activate sondern nach Betätigung eines Buttons (MAkro zuweisen). Da ich in VBA nicht der Held bin und mir diese Codes zusammengebastelt habe, benötige ich die Hilfe von Profis :-)
1) Sobald Tabellenblatt aktiviert wird, wird die Tabelle nach Spalte B sortiert
Private Sub Worksheet_Activate() ' CODE STEHT IN Tabelle1
Cells.Select
Cells.EntireRow.AutoFit
Range("A5:F741").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Key2:=Range("A6") _
, Order2:=xlAscending, Key3:=Range("C6"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A6").Select
End Sub
2) In Spalte B stehen verschiedene Fachabteilungen. Nach dem Sortieren wird hier nun ein roter Rahmen gezogen, um die Abteilungen auch optisch voneinander zu trennen:
Private Sub Worksheet_Change(ByVal Target As Range) ' CODE STEHT IN Tabelle1
If Target.Column = 2 Then
On Error GoTo errHandler
Application.EnableEvents = False
Rahmen_Check
End If
errHandler:
Application.EnableEvents = True
End Sub
Sub Rahmen_Check() ' CODE STEHT IN MODUL1
Dim c As Range, Ctmp As Range
For Each c In Range(Cells(6, 2), Cells(6, 2).End(xlDown)).SpecialCells(xlCellTypeVisible)
With Range(c.Offset(0, -1), c.Offset(0, 4))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
If Not Ctmp Is Nothing Then
If c Ctmp Then
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick 'fett
.ColorIndex = 3 'rot
End With
Else
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
End If
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Set Ctmp = c
Next c
Set c = Cells(65536, 2).End(xlUp)
With Range(c.Offset(0, -1), c.Offset(0, 4))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick 'fett
.ColorIndex = 3 'rot
End With
End With
End Sub
Danke vorab
TOM