Loop Macro

[Brian]

I have the following marco set up and I would like to have it loop searching
for the work "Completed" in column "H" until all are moved to the next
worksheet. Can anyone help?

Sub Active()
Application.ScreenUpdating = False

Columns("H:H").Select
Cells.Find(What:="completed", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Completed")) + 1
Set sourceRange = ActiveCell.EntireRow
Set destrange = Sheets("Completed").Rows(Lr)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete

Sheets("Active").Select
Range("A2").Select

Application.ScreenUpdating = True

End Sub

 

[ryguy7272]

You may have to change the sheet names in the code, but the basic premise is
here:
Sub newone()
Dim RngColF As Range
Dim i As Range
Dim Dest As Range
Sheets("Sheet1").Select
Set RngColF = Range("H1", Range("H" & Rows.Count).End(xlUp))
With Sheets("Sheet2")
Set Dest = .Range("A1")
End With
For Each i In RngColF
If i.Value = "Completed" Then
i.EntireRow.Copy Dest
Set Dest = Dest.Offset(1)
End If
Next i
End Sub


Regards,
Ryan---

 

[Brian]

Thank you so much. It works great.

You may have to change the sheet names in the code, but the basic premise is
here:
Sub newone()
Dim RngColF As Range
Dim i As Range
Dim Dest As Range
Sheets("Sheet1").Select
Set RngColF = Range("H1", Range("H" & Rows.Count).End(xlUp))
With Sheets("Sheet2")
Set Dest = .Range("A1")
End With
For Each i In RngColF
If i.Value = "Completed" Then
i.EntireRow.Copy Dest
Set Dest = Dest.Offset(1)
End If
Next i
End Sub


Regards,
Ryan---

 

[ryguy7272]

Ha!! Glad to hear it worked out for you. Please click the 'Yes' button if
this post was helpful for you. Others may benefit from this information too!!

Regards,
Ryan---