Sorry one of the carriage returns seems to have been deleted when thiss was
posted... And just a note don't try to copy something less than 1 time (which
really only makes sense anyway)

Sub test()
Call CopyTextMultipleTimes("Two", 2)
Call CopyTextMultipleTimes("Three", 3)

End Sub

Sub CopyTextMultipleTimes(ByVal TextToFind As String, ByVal Copies As Integer)
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyFrom As Range
Dim rngToSearch As Range

Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")

Dim rngCopyTo As Range
Dim rngCurrent As Range
Dim rngFirst As Range
Dim intCounter As Integer

Set rngToSearch = wksCopyFrom.Columns(1)
Set rngCurrent = rngToSearch.Find(TextToFind)
If Not rngCurrent Is Nothing Then
Set rngFirst = rngCurrent
Set rngCopyFrom = rngCurrent.EntireRow
Do
Set rngCopyFrom = Union(rngCurrent.EntireRow, rngCopyFrom)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address

For intCounter = 1 To Copies
Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)
rngCopyFrom.Copy rngCopyTo
Next intCounter
End If

End Sub

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

Try something like this. You will need to modify these two lines

Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")

To be the sheet name you are copying from and the sheet name you are copying
to.

Sub test()
Call CopyTextMultipleTimes("Two", 2)
Call CopyTextMultipleTimes("Three", 3)

End Sub

Sub CopyTextMultipleTimes(ByVal TextToFind As String, ByVal Copies As Integer)
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyFrom As Range
Dim rngToSearch As Range Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")

Dim rngCopyTo As Range
Dim rngCurrent As Range
Dim rngFirst As Range
Dim intCounter As Integer

Set rngToSearch = wksCopyFrom.Columns(1)
Set rngCurrent = rngToSearch.Find(TextToFind)
If Not rngCurrent Is Nothing Then
Set rngFirst = rngCurrent
Set rngCopyFrom = rngCurrent.EntireRow
Do
Set rngCopyFrom = Union(rngCurrent.EntireRow, rngCopyFrom)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address

For intCounter = 1 To Copies
Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)
rngCopyFrom.Copy rngCopyTo
Next intCounter
End If

End Sub

--
HTH...

Jim Thomlinson


"Patti" wrote:

I have a sheet in which every row needs to be copied to a new sheet, but a
variable number of times. Example (source sheet):

Column A Column B
"Two" Pete
"Three" John
"Three" Cindy

I want to look at *text* in column A and say "if A1 is Two then copy this
row to DestinationSheet 2 times, if text is Three copy 3 times." There
will only be 2 or 3 different conditions. When the loop is complete,
DestinationSheet would look like:

Column A Column B
"Two" Pete
"Two" Pete
"Three" John
"Three" John
"Three" John
"Three" Cindy
"Three" Cindy
"Three" Cindy

What is the most efficient way to do this?

Thanks in advance!

Patti