I can not get the following code to find all values "x" within (column A of
sheet 1); copy each of these EntireRows; find the first available row (or a
start row) in sheet 2 and paste all rows from sheet 1(all via a command
button):

Sub Rectangle1_Click()

Worksheets("Sheet 1").Select

With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy
Set c = .FindNext(c)
'Worksheets("Sheet 2").Select
'Worksheets("Sheet 2").Range("a8:a8").Select
'Worksheets("Sheet 2").Paste
'Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

So far I can find and copy the rows sequentially, but, can only paste
undesired results. I've tried numerous iterations.....Help Please!!

try this. UN tested

sub copyem()
With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'========
lr=sheets("sheet 2").cells(rows.count,"a").end(xlup).row+1
c.EntireRow.Copy sheets("sheet 2").rows(lr)
'=========
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
end sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I can not get the following code to find all values "x" within (column A
of
sheet 1); copy each of these EntireRows; find the first available row (or
a
start row) in sheet 2 and paste all rows from sheet 1(all via a command
button):

Sub Rectangle1_Click()

Worksheets("Sheet 1").Select

With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy
Set c = .FindNext(c)
'Worksheets("Sheet 2").Select
'Worksheets("Sheet 2").Range("a8:a8").Select
'Worksheets("Sheet 2").Paste
'Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

So far I can find and copy the rows sequentially, but, can only paste
undesired results. I've tried numerous iterations.....Help Please!!

This should work. I changed "Sheet 1" to "sheet1" and "Sheet 2" to "Sheet2"
and added a row counter to put results in a new row.


Sub Rectangle1_Click()

RowCount = 8

With Worksheets("Sheet1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy _
Destination:=Worksheets("Sheet2").Rows(RowCount)
RowCount = RowCount + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

"CROD" wrote:

I can not get the following code to find all values "x" within (column A of
sheet 1); copy each of these EntireRows; find the first available row (or a
start row) in sheet 2 and paste all rows from sheet 1(all via a command
button):

Sub Rectangle1_Click()

Worksheets("Sheet 1").Select

With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy
Set c = .FindNext(c)
'Worksheets("Sheet 2").Select
'Worksheets("Sheet 2").Range("a8:a8").Select
'Worksheets("Sheet 2").Paste
'Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

So far I can find and copy the rows sequentially, but, can only paste
undesired results. I've tried numerous iterations.....Help Please!!

Don, thanks for your help and the speedy turnaround!! While it seems to run
(when I click the command button), no copy or paste actually takes place. i
can see something is running, but again, no results.

Is my command button interferring with things: I have "Sub
Rectangle1_Click()". Should replace this with "Sub Copyem()"?

Again, thanks for all your help and expertise!!!

"Don Guillett" wrote:

try this. UN tested

sub copyem()
With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'========
lr=sheets("sheet 2").cells(rows.count,"a").end(xlup).row+1
c.EntireRow.Copy sheets("sheet 2").rows(lr)
'=========
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
end sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I can not get the following code to find all values "x" within (column A
of
sheet 1); copy each of these EntireRows; find the first available row (or
a
start row) in sheet 2 and paste all rows from sheet 1(all via a command
button):

Sub Rectangle1_Click()

Worksheets("Sheet 1").Select

With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy
Set c = .FindNext(c)
'Worksheets("Sheet 2").Select
'Worksheets("Sheet 2").Range("a8:a8").Select
'Worksheets("Sheet 2").Paste
'Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

So far I can find and copy the rows sequentially, but, can only paste
undesired results. I've tried numerous iterations.....Help Please!!

Don, thanks for your help and the speedy turnaround!! While it seems to run
(when I click the command button), no copy or paste actually takes place. i
can see something is running, but again, no results.

Is my command button interferring with things: I have "Sub
Rectangle1_Click()". Should replace this with "Sub Copyem()"?

Again, thanks for all your help and expertise!!

"Don Guillett" wrote:

try this. UN tested

sub copyem()
With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'========
lr=sheets("sheet 2").cells(rows.count,"a").end(xlup).row+1
c.EntireRow.Copy sheets("sheet 2").rows(lr)
'=========
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
end sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I can not get the following code to find all values "x" within (column A
of
sheet 1); copy each of these EntireRows; find the first available row (or
a
start row) in sheet 2 and paste all rows from sheet 1(all via a command
button):

Sub Rectangle1_Click()

Worksheets("Sheet 1").Select

With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy
Set c = .FindNext(c)
'Worksheets("Sheet 2").Select
'Worksheets("Sheet 2").Range("a8:a8").Select
'Worksheets("Sheet 2").Paste
'Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

So far I can find and copy the rows sequentially, but, can only paste
undesired results. I've tried numerous iterations.....Help Please!!

Joel,

It worked!! Well done and much appreciated.....you've literally saved me
hours of work and my sanity!

"Joel" wrote:

This should work. I changed "Sheet 1" to "sheet1" and "Sheet 2" to "Sheet2"
and added a row counter to put results in a new row.


Sub Rectangle1_Click()

RowCount = 8

With Worksheets("Sheet1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy _
Destination:=Worksheets("Sheet2").Rows(RowCount)
RowCount = RowCount + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

"CROD" wrote:

I can not get the following code to find all values "x" within (column A of
sheet 1); copy each of these EntireRows; find the first available row (or a
start row) in sheet 2 and paste all rows from sheet 1(all via a command
button):

Sub Rectangle1_Click()

Worksheets("Sheet 1").Select

With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy
Set c = .FindNext(c)
'Worksheets("Sheet 2").Select
'Worksheets("Sheet 2").Range("a8:a8").Select
'Worksheets("Sheet 2").Paste
'Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

So far I can find and copy the rows sequentially, but, can only paste
undesired results. I've tried numerous iterations.....Help Please!!

Don,

Thanks again for your assistance!

"Don Guillett" wrote:

try this. UN tested

sub copyem()
With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'========
lr=sheets("sheet 2").cells(rows.count,"a").end(xlup).row+1
c.EntireRow.Copy sheets("sheet 2").rows(lr)
'=========
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
end sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I can not get the following code to find all values "x" within (column A
of
sheet 1); copy each of these EntireRows; find the first available row (or
a
start row) in sheet 2 and paste all rows from sheet 1(all via a command
button):

Sub Rectangle1_Click()

Worksheets("Sheet 1").Select

With Worksheets("Sheet 1").Range("a1:a200")
Set c = .Find("NJ1S", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy
Set c = .FindNext(c)
'Worksheets("Sheet 2").Select
'Worksheets("Sheet 2").Range("a8:a8").Select
'Worksheets("Sheet 2").Paste
'Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With
End Sub

So far I can find and copy the rows sequentially, but, can only paste
undesired results. I've tried numerous iterations.....Help Please!!