Zeile markieren und in leere Zeile kopieren

Hallo, ich würde gerne eine bestimmte Zeile, die eine Bedingung erfüllt kopieren und in die erste leere Zeile eines neu erstellen Sheets einfügen. Das auslesen und die Bedingungen, sowie das Kopieren funktionieren soweit.
Leider funktioniert der Teil, bei dem ich einfügen möchte nicht. Kann mir jemand behilflich sein? Vielen Dank für Tipps.

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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).PasteSepcial Paste:=xlValues(Leerzeile = _ Leerzeile + 1) Next Zähler Application.ScreenUpdating = True MsgBox ("Ihre Daten wurden kopiert.") End Sub

Sub SFC_Bedingungen_beta() 'Deklarationsbereich Dim Zaehler As Long Dim iZeile As Long Dim jZeile As Long Dim wks As Worksheet Dim rngCopy As Range Application.ScreenUpdating = False With Sheets("Tabelle3") iZeile = 9 jZeile = .UsedRange.Rows.Count 'Anweisungsbereich 'Stromdichten auf 4 Nachkommastellen runden For Zaehler = iZeile To jZeile .Cells(Zaehler, 37).Value = Round(.Cells(Zaehler, 6), 3) Next Zaehler 'Zeilenwerte auslesen und sammeln For Zaehler = iZeile To jZeile If .Cells(Zaehler, 37).Value = 0.225 Then If rngCopy Is Nothing Then Set rngCopy = .Rows(Zaehler) Else Set rngCopy = Union(rngCopy, .Rows(Zaehler)) End If End If Next Zaehler End With If Not rngCopy Is Nothing Then 'wenn was gefunden wurde Set wks = Worksheets.Add(After:=Sheets(Sheets.Count)) rngCopy.Copy wks.Cells(2, 1).PasteSpecial xlPasteValues MsgBox ("Ihre Daten wurden kopiert.") Else 'wenn nicht MsgBox "Keine Daten zu kopieren.", , "Gebe bekannt..." End If End Sub

Beliebteste Forumthreads (12 Monate)

Zeile markieren und in leere Zeile kopieren

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

269 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile markieren und in leere Zeile kopieren

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

269 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread