Hallo Karin wäre es möglich, wenn ich in Spalte G etwas eintrage, erst dann soll diese Zahl oder Text solange nach unten kopiert werden solange in Spalte A etwas enthalten ist. Ich müsste das in den nachfolgenden makro einbauen. Vielen Dank im Voraus.
Sub nachJahrSortieren()
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
ActiveSheet.EnableOutlining = True 'für Gliederung
ActiveSheet.EnableAutoFilter = True 'AutoFilter trotz Blattschutz
Sheets("Alle Teilnehmer").Activate
ActiveSheet.Range("A:n").Select 'ab Spalte G2 sortieren von Z bis A
Selection.Sort Key1:=Range("G2"), Key2:=Range("B2"), _
Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Dim lngLetzte As Long 'Formel ab Spalte H2:I2 eintragen
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Cells(2, 8).Formula = "=IF(COUNTIF($I$2:I2,I2)=1,COUNTIF(I:I,I2),"""")"
Cells(2, 9).Formula = "=IF(B2="""","""",B2&"" ""&C2&"" ""&E2)"
Cells(2, 11).Formula = "=IF(AND(H2=1,G2=$L$1),""neu"","""")"
Range("i2:H2").AutoFill Destination:=Range(Cells(2, 8), Cells(lngLetzte, 9)), Type:=xlFillDefault
Range("k2").AutoFill Destination:=Range(Cells(2, 11), Cells(lngLetzte, 11)), Type:=xlFillDefault
With Range("j2:J2") ' Spalten und Rahmenfarbe ab Spalte J2 eintragen
.HorizontalAlignment = xlCenter
.Interior.Color = 13750737
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = 11184814
.Weight = xlThin
End With
.AutoFill Destination:=Range(Cells(2, 10), Cells(lngLetzte, 10)), Type:=xlFillFormats
End With
Application.ScreenUpdating = True 'Bildschirmaktualisierung einschalten
Range("G2").Select
End Sub