Makro auf alle Listenlängen anwenden ?
15.03.2022 08:25:33
Weber
ich bin ein Neuling im Bereich VBA und genieße hoffentlich noch Welpenschutz :)
Zu meinem Anliegen ich habe ein Makro erstellt, das eine Liste (die immer Gleich exportiert wird) automatisch in ein gewünschtes Format bringen soll.
Jedoch ist die Liste nicht kompatibel, wenn die Splaten z.b mehr Einträge haben. Meine Frage ist, was muss ich jetzt anpassen, dass ich dieses Makro auf alle Spaltenlängen anwenden kann. Habe erfolglos probiert darin rum zu Basteln und Frage deshalb mal ins Forum :)
- > Die Teilergebnisse und die Links Rechts Formel werden nicht wie gewünscht ausgeführt, also bis zum Ender der Spalte dachte das ist so einfach wenn ich dem Makro zeige: "shift+strg+pfeil unten drücke" das es dann immer weiß gehe bis zum Ende der Spalte ( Bei der Rechts Formel Springt es sogar irgendwann auf die Spalte links daneben und überschreibt ab einer gewissen Zeile deren Einträge mit der Formel Rechts)
Vielen Dank im Voraus schonmal!
Sub Liste_52_Formatierung()
' Liste_52_Formatierung Makro
Application.WindowState = xlNormal
End Sub
Sub Makro_Liste()
' Makro_Liste Makro
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Style = "Currency"
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Style = "Currency"
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[397]C)"
Range("D2").Select
ActiveWindow.SmallScroll Down:=-27
Range("D1").Select
Selection.Style = "Currency"
Selection.Font.Bold = True
Range("E1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[397]C)"
Range("E2").Select
ActiveWindow.SmallScroll Down:=-39
Range("E1").Select
Selection.Style = "Currency"
Selection.Font.Bold = True
Range("J3").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-8],5)"
Range("J3").Select
Selection.AutoFill Destination:=Range("J3:J398")
Range("J3:J398").Select
Range("K3").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-9],3)"
Range("K3").Select
Selection.AutoFill Destination:=Range("K3:K398")
Range("K3:K398").Select
Range("J1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(2,R[2]C[-8]:R[397]C[-8])"
Range("J2").Select
ActiveWindow.SmallScroll Down:=-33
Range("J1").Select
Selection.Font.Bold = True
Range("L3").Select
ActiveCell.FormulaR1C1 = "erledigt"
Range("L4").Select
End Sub