Zelleninhalt kopieren falls gewisser Wert vorhanden

[fiesta_xr2i]

Ich habe ein Makro geschrieben welches folgende Funktion hat:
Im ersten Teil wird ein gewisser Teil markiert und anschliessend in ein anderes Tabellenblatt eingefügt.

Im zweiten Teil sollte das Makro bei Tabelle Übersicht in der H von H5 bis H220 kontrollieren ob der Wert 1 vorkommt. Falls der Wert 1 vorkommt soll die komplette Zeile kopiert werden und in die Tabelle Teilnetz_1_OS_Glis eingefügt werden.

Das kopieren des ersten Teils klappt wunderbar, der zweite Teil wird auch kopiert aber sogleich wieder gelöscht und es entsteht eine Fehlermeldung in der rot markierten Zelle.

Sub Makro1()
Sheets("Übersicht").Select
Range("A2:BG4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Teilnetz_1_OS_Glis").Select
Range("A1").Select
ActiveSheet.Paste

For j = 1 To 220
Copy = 0
For i = 5 To 220
If Sheets("Übersicht").Cells(i, 8) = 1 Then
Copy = Copy + Sheets("Übersicht").Rows("i:i").Select.Copy
End If
Next i
Sheets("Teilnetz_1_OS_Glis").Cells(j + 3, 1).Paste = Copy
Next j


End Sub

Vielen Dank für eure Hilfe

[Tanto]

Hallo Community

Eine Variante wäre das

Liebe Grüße Tanto

 
Sub FilterKopieren()
    Worksheets("Tabelle1").Range("A1").AutoFilter Field:=1, Criteria1:=1
    Worksheets("Tabelle1").Rows("2:" & Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy Worksheets("Tabelle2").Range("A" & Worksheets("Tabelle2").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
    Worksheets("Tabelle1").Range("A1").AutoFilter
End Sub

[fiesta_xr2i]

funktioniert nicht kopiert nicht die Zeile in welcher sich auch eine 1 in der Spalte H befindet.
Könntest du vielleicht beim nächsten Vorschlag die Tabellennamen und Zellen verweise anpassen damit es mit meinen überein stimmt - vielen Dank

[Tanto]

Hallo Community

Angepasste Variante wäre das

Liebe Grüße Tanto

 
Sub FilterKopieren()
    Worksheets("Übersicht").Range("H1").AutoFilter Field:=1, Criteria1:=1
    Worksheets("Übersicht").Rows("2:" & Worksheets("Übersicht").UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy Worksheets("Teilnetz_1_OS_Glis").Range("A" & Worksheets("Teilnetz_1_OS_Glis").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
    Worksheets("Übersicht").Range("H1").AutoFilter
End Sub