End With one With
18.05.2021 16:36:48
Christian
ich bitte um eure Hilfe. Be untem stehenden Makro bekomme ich beim Asführen die Meldung End With one With.
Ich habe aber keine Ahnung wo ein With fehlen sollte.
Markiert wird das End With in der 3.letzen Zeile
Bitte helft mir.
Gruß
Christian
End With one With
Sub Makro3()
Dim loLetzte As Long, j As Long, x As Long, lC As Long
Application.ScreenUpdating = False
With Worksheets("Ergebnis")
loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("B1:C1").Copy .Range("B1:C" & loLetzte)
.Range("B2:C" & loLetzte).Formula = .Range("B2:C" & loLetzte).Value2
.Range("E1:F1").Copy .Range("E2:F" & loLetzte)
.Range("E2:F" & loLetzte).Formula = .Range("E2:F" & loLetzte).Value2
.Range("Q1") = "Formel" 'Zeile 1 markieren!!
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C1:C" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F1:F" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:P1" & loLetzte)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Zeile der Markierung in Spalte l suchen
x = .Cells(Rows.Count, 17).End(xlUp).Row
'Formeln ggf. in Zeile1 zurück kopieren
If x > 1 Then
.Cells(x, 2).Resize(1, 2).Copy .Range("B1")
.Cells(x, 5).Resize(1, 12).Copy .Range("E1")
.Cells(x, 5).Copy .Range("E1")
.Rows(x).Value = .Rows(x).Value
.Range("G1:P1").Copy .Range("G2:P" & loLetzte)
.Range("G2:P" & loLetzte).Formula = .Range("G2:P" & loLetzte).Value2
.Cells(x, 17) = Empty 'markierung löschen
.Range("A1").Select
End With
Application.CutCopyMode = False
End Sub
Anzeige