Office: Excel Makro macht die falschen Aktionen :-(

Hallo Geminde ;-)
ich habe in der Firma einen schönes Makro erstellt mit dem eine Liste die immer gleich verändert wird automatisiert wird.
Leider macht er bei aktivieren des Makros nicht das was ich ihm beim aufzeichenen gezeigt habe :-(

Sieht jemand den Fehler in meinem System. Habe es mit Office 2003 erstellt.

Das ist der Makro:

Sub Standtage2()
'
' Standtage2 Makro
' Makro am 04.08.2011 von Heckhoff, Tim (204) aufgezeichnet
'

'
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Range("A2").Activate
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "Standtage"
Range("A3").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[9]C[4]="""","""",(TODAY()-(IF(R[9]C[5]=""#"",R[9]C[4],(IF(R[9]C[5]>R[9]C[4],R[9]C[5],R[9]C[4]))))))"
Range("A3").Select
Selection.AutoFill Destination:=Range("A3:A125")
Range("A3:A125").Select
ActiveWindow.SmallScroll Down:=-42
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("A:A").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Interior.ColorIndex = 15
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("A:A").Select
Selection.NumberFormat = "General"
Range("A7").Select
End Sub


Er fügt zum beispiel wenn ich es in einer leeren Datei anwende plötzlich vier Spalten ein warum auch immer :-(

 

Soweit ich das sehe, ist das da oben der einzige Punkt, an dem was spaltenweise eingefügt wird. Und solange das Makro nicht 4x aufgerufen wird, sehe ich keinen Grund, warum mehr als eine Spalte eingefügt werden sollte.

Das ganze .activate und .select Gedöns vom Makro-Rekorder ist schon manchmal echt schlimm. Es müßte auch gehen:

Code:

    Columns("A:A").Insert Shift:=xlToRight

Gruß, Michael

 

Wow das hat wunderbar geklappt, obwohl ich jetzt selber etwas verwirrt bin warum.
Naja sei es drum.

Kann man jetzt diesen Befehl noch so anpassen, dass er das ganze beliebig weit nach unten ausfüllt wenn jetzt die zu bearbeitende Tabelle länger wird?

Selection.AutoFill Destination:=Range("A12:A134")

Also nicht bis A134 sondern bis zu der letzten beschriebenen Zelle??

 

Theoretisch gesehen sollte das u.a. Makro genau das gleiche wie vorher tun. Es ist nur sauber formatiert und von etlichem Ballast befreit. Probier mal zuerst aus, ob es wirklich immer noch das tut, was es soll.

Dann wirst Du in dem Makro 3 ' Zeilen finden, also auskommentierte Code-Zeilen. Die sind die Vorbereitung für Deine Frage. Gegenfrage aber ist: Letzte beschriebene Zeile von wo aus in welche Richtung?

Du hast ja, als Du das Makro aufgezeichnet hast, auch bereits 2x die letzte Zeile von A2 ausgehend bestimmt, einmal nach unten und einmal nach rechts. Soll wieder von A2 ausgegangen werden? Dann brauchst Du nur die 3 ' entfernen und die AutoFill-Zeile mit der festen 125 löschen.

Ansonsten kannst Du in der 2. ' Zeile ("y = ...") die Zelle anpassen, von der aus geschaut werden soll.

Code:

Sub Standtage2b()
    'Dim y As Long
    Rows("1:9").Delete Shift:=xlUp
    Columns("a:a").Insert Shift:=xlToRight
    Range("a2").Value = "Standtage"
    Range("a3").Formula = "=if(e12="""","""",(today()-(if(f12=""#"",e12,(if(f12>e12,f12,e12))))))"
    'y = Range("a2").End(xlDown).Row
    Range("a3").AutoFill Destination:=Range("a3:a125")
    'Range("a3").AutoFill Destination:=Range("a3:a" & y)
    Range("a2").End(xlToRight).End(xlDown).Sort _
        Key1:=Range("a3"), _
        Order1:=xlDescending, _
        Header:=xlGuess
    Columns("a:a").Interior.Pattern = xlSolid
    Columns("a:a").Interior.ColorIndex = 15
    Range("a2").End(xlDown).End(xlToRight).Sort _
        Key1:=Range("a3"), _
        Order1:=xlDescending, _
        Header:=xlGuess
    Columns("a:a").NumberFormat = "General"
End Sub

Gruß, Michael