Code ändern für "bis zur letzten Spalte"
WalterK
nachfolgenden Code habe ich mit dem Rekorder und mit Hilfe im Forum zusammengebastelt, funktioniert auch ganz gut.
Es geht jetzt noch darum, dass ich für
1.) das Setzen des Filters,
2.) das Kopieren der Formel in Zeile 1 und
3.) das Erstellen der Hintergrundfarbe in Zeile 1 und 2
fix die Spalten A bis AZ angeführt habe und das hätte ich gerne geändert.
All diese Punkte sollen ausgehend von Spalte A nur bis zur letzten befüllten Spalte durchgeführt werden. Die letzte Spalte kann jedes Mal eine andere sein.
Kann mir bitte jemand die Änderungen im Code durchführen?
Hier mein Code:
Option Explicit
Sub Tabelleeinrichten()
Dim lngA As Long
Application.ScreenUpdating = False
Columns("A:AZ").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With Selection.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveWindow.Zoom = 85
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Rows(1).Insert
lngA = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:AZ2").AutoFilter
With Range("A1")
.FormulaLocal = _
"=WENN(oder(ODER(A2="""";A2=""Datum"";A2=""Frist"";A2=""Faellig"";A2=""Eintritt""; _
A2=""Austritt"";A2=""Klnr"";A2=""von"";A2=""bis"");oder(A2=""LA"";A2=""Jahr"";A2=""FstNr"";A2=""Tage"";A2=""Anz.Fst""));"""";" & _
"WENN(ISTZAHL(A3);TEILERGEBNIS(9;A3:A" & lngA & ");""""))"
.NumberFormat = "#,##0.00"
.AutoFill Destination:=Range("A1:AZ1"), Type:=xlFillDefault
End With
Range("A1:AZ1").Select
Columns("A:AZ").Select
Columns("A:AZ").EntireColumn.AutoFit
Cells.Select
Selection.NumberFormat = "#,##0.00 _;[Red]-#,##0.00 _;"
Range("A1").Select
Range("A2").Select
Range("A1:AZ1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
Range("A2:AZ2").Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
Range("A2").Select
Application.ScreenUpdating = True
End Sub
Besten Dank und Servus, Walter
Anzeige