Sub SFC_Bedingungen_beta()
Application.ScreenUpdating = False
'Neues Sheet hinzufügen
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Tabelle3").Select
'Deklarationsbereich
Dim Zähler As Long
Dim iZeile As Long
Dim jZeile As Long
Dim Leerzeile As Long
iZeile = 9
jZeile = ActiveSheet.UsedRange.Rows.Count
Leerzeile = Sheets(Sheets.Count).Cells(65000, 1).End(xlUp).Offset(1, 0)
'Anweisungsbereich
'Stromdichten auf 4 Nachkommastellen runden
For Zähler = iZeile To jZeile
Cells(Zähler, 37).Value = Round(Cells(Zähler, 6), 3)
Next Zähler
'Zeilenwerte auslesen und kopieren
For Zähler = iZeile To jZeile
Cells(Zähler, 37).Select
If ActiveCell.Value = 0.225 Then ActiveCell.EntireRow.Copy
Sheets(Sheets.Count).Cells("Leerzeile").PasteSpecial Paste:=xlValues
Next Zähler
Application.ScreenUpdating = True
MsgBox ("Ihre Daten wurden kopiert.")
End Sub