|
Hallo,
ich habe mithilfe des Rekorders ein Makro gebaut und möchte nun am Ende, dass es vom letzten Tabelleblatt zum ersten wechselt. Damit jeder User auch am Anfang beginnt. Dies ist der Code, doch das letzte Stück fehlt mir. Kann mir einer bitte weiterhelen und mir sagen was ich in das bestehende eintragen soll? siehe weiter unten
Sub COBExcelSauberVerlassen()
'
' Spalten ausblenden
' Filter entfernen/richtig setzen
' Höhe und Breite der Zelle
' Schrift
' Position 1
' Textumbruch
' keine Rahmen
' Zoom bei 80
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
ActiveSheet.ShowAllData
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:2").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.PatternTintAndShade = 0
End With
Rows("1:1").Select
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("2:500").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.RowHeight = 90
Rows("1:2").Select
Selection.RowHeight = 40
Columns("A:C").Select
Selection.ColumnWidth = 8
Columns("D:F").Select
Selection.ColumnWidth = 25
Columns("G:I").Select
Selection.ColumnWidth = 15
Columns("J:M").Select
Selection.ColumnWidth = 40
Columns("N:O").Select
Selection.ColumnWidth = 11
Columns("P:Q").Select
Selection.ColumnWidth = 22
Columns("R:R").Select
Selection.ColumnWidth = 11
Columns("S:V").Select
Selection.ColumnWidth = 22
Columns("W:X").Select
Selection.ColumnWidth = 11
Columns("G:I").Select
Selection.EntireColumn.Hidden = True
Columns("O:P").Select
Selection.EntireColumn.Hidden = True
ActiveSheet.Range("$A$2:$Y$500").AutoFilter Field:=23, Criteria1:=Array( _
"Ja", "Ja / für CoMa 3 umstellen", "Nein"), Operator:=xlFilterValues
Range("B3").Select
Range("D1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"http://www.wss.hays-gsc.loc/entrance/ProjekteLink/Unison/Projekte/austausch/Freigegebene%20Dokumente/Contracting/Contracting%20D.xlsx?Web=1" _
, TextToDisplay:="Link -> Standard COB Excel"
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorHyperlink
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.Zoom = 80
Next
End Sub
Sub GoToFirstSheet()
On Error Resume Next
Sheets(1).Select
End Sub
Der Rote Teil ist das was ich gefunden habe, kann es aber nicht in das obere integrieren :-(
Bitte um Hilfe.
Danke und VG Natalia
|