Hi,

Can someone help to write a macro doing the following:

1. Search the word "test" in specified selection (A3:G68)
2. When found, then copy the whole row in which the word was found to "A100"
3. Next look up for the word "test", and when found copy the whole row to
"A101"
4. Continue serch for the word "test" and copy to "A102" and so on until no
more is found.

Thank you in advance.

Kaj Pedersen

Hi Kaj,

Am Thu, 28 Feb 2013 08:58:59 +0100 schrieb KP:

1. Search the word "test" in specified selection (A3:G68)
2. When found, then copy the whole row in which the word was found to "A100"
3. Next look up for the word "test", and when found copy the whole row to
"A101"
4. Continue serch for the word "test" and copy to "A102" and so on until no
more is found.

try:

Sub myCopy()
Dim i As Integer
Dim c As Range
Dim firstAddress As String

i = 100
With Range("A3:G68")
Set c = .Find("test", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy Cells(i, 1)
i = i + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Claus,

It works perfectly and I got what I was asking for. However, I still have a
little problem.
Is it possible instead of copying the whole row to define the area to be
copied?
(e.g. column A to column G in the actual found row?)

Regards,
Kaj Pedersen


"Claus Busch" skrev i meddelelsen ...

Hi Kaj,

Am Thu, 28 Feb 2013 08:58:59 +0100 schrieb KP:

1. Search the word "test" in specified selection (A3:G68)
2. When found, then copy the whole row in which the word was found to
"A100"
3. Next look up for the word "test", and when found copy the whole row to
"A101"
4. Continue serch for the word "test" and copy to "A102" and so on until
no
more is found.

try:

Sub myCopy()
Dim i As Integer
Dim c As Range
Dim firstAddress As String

i = 100
With Range("A3:G68")
Set c = .Find("test", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy Cells(i, 1)
i = i + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Kaj,

Am Thu, 28 Feb 2013 10:09:20 +0100 schrieb KP:

Is it possible instead of copying the whole row to define the area to be
copied?
(e.g. column A to column G in the actual found row?)

change c.EntireRow.Copy to:
Range(Cells(c.Row, 1), Cells(c.Row, 7)).Copy


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Claus,

I tried your suggestion but I think something must be missing in the macro.
The selection was copied to clipboard, but nothing was pasted and no new
search for
the next word "test" was carried out.

By the way, I would rather like to to copy from column B to column G instead
of
column A to G.
Is it possible?

Regards,
Kaj Pedersen


"Claus Busch" skrev i meddelelsen ...

Hi Kaj,

Am Thu, 28 Feb 2013 10:09:20 +0100 schrieb KP:

Is it possible instead of copying the whole row to define the area to be
copied?
(e.g. column A to column G in the actual found row?)

change c.EntireRow.Copy to:
Range(Cells(c.Row, 1), Cells(c.Row, 7)).Copy


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Kaj,

Am Thu, 28 Feb 2013 10:46:24 +0100 schrieb KP:

By the way, I would rather like to to copy from column B to column G instead
of
column A to G.

try:
Sub myCopy()
Dim i As Integer
Dim c As Range
Dim firstAddress As String

i = 100
With Range("A3:G68")
Set c = .Find("test", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(Cells(c.Row, 2), Cells(c.Row, 7)).Copy _
Cells(i, 1)
i = i + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Claus,

Now everything works to my fully satisfaction.
I wish to thank you very much for your exellent and professionel help.

Best regards,
Kaj Pedersen



"Claus Busch" skrev i meddelelsen ...

Hi Kaj,

Am Thu, 28 Feb 2013 10:46:24 +0100 schrieb KP:

By the way, I would rather like to to copy from column B to column G
instead
of
column A to G.

try:
Sub myCopy()
Dim i As Integer
Dim c As Range
Dim firstAddress As String

i = 100
With Range("A3:G68")
Set c = .Find("test", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(Cells(c.Row, 2), Cells(c.Row, 7)).Copy _
Cells(i, 1)
i = i + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2