Hi there,

I have recorded a macro that does a search and then copies data from one
cell to another. I want it to loop until it finds the last occurrance of the
search parameter. I understand that there is a VB command "DoUntil"? What
would I put after this please? How do I make it loop?

This is my macro:

Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="sub", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
End Sub

Thanks in advance,
Martin

One way:

Public Sub CopyStuff()
Dim rFound As Range
Dim rDest As Range
Dim sFirstAddress As String
Set rDest = Sheets("Book1NEW").Cells( _
Rows.Count, 1).End(xlUp).Offset(1, 0)
With Sheets("Book1")
Set rFound = .Cells.Find( _
What:="sub", _
After:=.Cells(1, 1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rFound Is Nothing Then
sFirstAddress = rFound.Address
Do
With rFound
If .Row 2 Then
.Offset(-2, 0).Copy Destination:=.Cells
.Offset(-2, 6).Copy Destination:= _
.Offset(0, 6)
.Copy Destination:=rDest
.Offset(0, 4).Resize(1, 3).Copy _
Destination:=rDest.Offset(0, 1)
Set rDest = rDest.Offset(1, 0)
End If
End With
Set rFound = .Cells.FindNext(after:=rFound)
Loop Until rFound Is Nothing
End If
End With
End Sub



In article ,
"Martin" wrote:

Hi there,

I have recorded a macro that does a search and then copies data from one
cell to another. I want it to loop until it finds the last occurrance of the
search parameter. I understand that there is a VB command "DoUntil"? What
would I put after this please? How do I make it loop?

This is my macro:

Sheets("Book1").Select
Application.Goto Reference:="R1C1"
Cells.Find(What:="sub", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -6).Range("A1:G1").Select
ActiveCell.Activate
Selection.Copy
Sheets("Book1NEW").Select
Application.Goto Reference:="R60000C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Cut Destination:=ActiveCell.Offset(0, -3).Range("A1:C1")
ActiveCell.Offset(0, -3).Range("A1:C1").Select
Sheets("Book1").Select
End Sub

Thanks in advance,
Martin