automatisches Zeilenkopieren

Ich möchte alle nicht zusammenhängenden Zeilen von Tabelle 3, die in der Spalte B den Wert 45 enthalten, in eine neue Tabelle 4 kopieren, natürlich ohne Lücken und möglichst automatisch.
Hier zu mein fehlgeschlagener Versuch:

Sub ZeilenKopieren()
Dim i As Integer
Dim anz0 As Integer

i = 4
anz0 = 4

Do Until i = Sheets(3).UsedRange.Rows.Count
If Sheets(3).Range("B" & i).Value = 45 Then _
Sheets(3).Range("A" & i).Select
Selection.EntireRow.Copy
i = i + 1
Sheets(4).Activate
Sheets(4).Range("A" & anz0).Select
ActiveSheet.Paste
anz0 = anz0 + 1
Loop
End Sub

Ich bedanke mich über jeden Tip!
Katina