Code vereinfachen
Holger
ich praktiziere grad "learning by doing". Deswegen würde ich gerne den unten stehenden Code vereinfachen. Besonders den untere (kursiven) Teil.
Sub Zinszahlungen_lfd_Jahr()
Dim ZZ$, Inv$
ZZ = "Zinszahlungen lfd. Jahr"
Inv = "Inventar"
Sheets(ZZ).Unprotect
Range("A14:Z120").Clear
With Sheets(Inv)
.Range("p1").Copy Sheets(ZZ).Range("l1")
.Range("A10:AM102").AutoFilter Field:=2, Criteria1:=""
.Range("A15:F110").Copy Sheets(ZZ).Range("A14")
.Range("T15:U110").Copy Sheets(ZZ).Range("G14")
.Range("z15:Ac110").Copy Sheets(ZZ).Range("I14")
.Range("A8").AutoFilter
End With
With Sheets(ZZ).Range("N14").Select
ActiveCell.FormulaR1C1 = "=DATE(YEAR(R1C12),MONTH(RC[-4]),DAY(RC[-4]))"
Selection.AutoFill Destination:=Range("N14:N50"), Type:=xlFillDefault
End With
With Sheets(ZZ).Range("O14").Select
ActiveCell.FormulaR1C1 = "=IF(YEAR(RC[-1])=YEAR(R1C12),RC[-1],"""")"
Selection.AutoFill Destination:=Range("O14:O50"), Type:=xlFillDefault
End With
With Sheets(ZZ).Range("P14").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-1]),"""",RC[-1])"
Selection.AutoFill Destination:=Range("P14:P50"), Type:=xlFillDefault
End With
Sheets(ZZ).Range("P14:P50").Copy
Range("J14").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("a14:L50").Sort Key1:=Range("J14"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("J14:J50").Font.Bold = True
Range("J14:J50").NumberFormat = "dd/mm/"
Range("L14:L50").Font.Bold = True
Range("N14:Q51").Clear
ActiveWindow.SmallScroll ToRight:=-5
Range("L1").Select
ActiveSheet.Protect
End Sub
Mag mir jemand helfen?
Schöne Grüße
Holger