copying multiple row to a new sheet
 

I got my code working where it copies a row and moves it over to the other sheet, but if I have multiple rows to move over it only moves the first row that is true, but not the others. How can I get it to move every row that is true over to a new sheet. Here's my code

Dim rng As Range, cell As Range, rng1 As Rang
Set rng = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp)
Set rng1 = Nothin
For Each cell In rn
If cell.Value = "True" The
If rng1 Is Nothing The
Set rng1 = cel
Els
Set rng1 = Union(rng1, cell
End I
End I
Nex
If Not rng1 Is Nothing The
rng1.Range("B1:H1").Copy Destination:=Worksheets("Sheet2").Range("B2"
End I

copying multiple row to a new sheet
 

Hi
try changing the line
rng1.Range("B1:H1").Copy Destination:=Worksheets("Sheet2").Range("B2")

to
rng1.Copy Destination:=Worksheets("Sheet2").Range("B2")


--
Regards
Frank Kabel
Frankfurt, Germany

still stuck wrote:
I got my code working where it copies a row and moves it over to the
other sheet, but if I have multiple rows to move over it only moves
the first row that is true, but not the others. How can I get it to
move every row that is true over to a new sheet. Here's my code:

Dim rng As Range, cell As Range, rng1 As Range
Set rng = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp))
Set rng1 = Nothing
For Each cell In rng
If cell.Value = "True" Then
If rng1 Is Nothing Then
Set rng1 = cell
Else
Set rng1 = Union(rng1, cell)
End If
End If
Next
If Not rng1 Is Nothing Then
rng1.Range("B1:H1").Copy
Destination:=Worksheets("Sheet2").Range("B2") End If

copying multiple row to a new sheet
 

Try this

This example you can use for more words also
See the Array

Sub Union_Examples()
Dim myArr As Variant
Dim FirstAddress As String
Dim Rng As Range
Dim Totrng As Range
Dim I As Long

Application.ScreenUpdating = False
myArr = Array("True")

For I = LBound(myArr) To UBound(myArr)

Set Rng = Range("B:B").Find(What:=myArr(I), After:=Range("B" _
& Rows.Count), LookAt:=xlWhole)
'If you want to search in a part of the rng.value then use xlPart

If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
If Totrng Is Nothing Then
Set Totrng = Rng
Else
Set Totrng = Application.Union(Totrng, Rng)
End If
Set Rng = Range("B:B").FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address < FirstAddress
End If
Next I
If Not Totrng Is Nothing Then
Totrng.EntireRow.Copy Sheets(2).Rows(2)
'Copy to another sheet
End If
Application.ScreenUpdating = True
End Sub



--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"still stuck" wrote in message ...
I got my code working where it copies a row and moves it over to the other sheet, but if I have multiple rows to move over it
only moves the first row that is true, but not the others. How can I get it to move every row that is true over to a new sheet.
Here's my code:

Dim rng As Range, cell As Range, rng1 As Range
Set rng = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp))
Set rng1 = Nothing
For Each cell In rng
If cell.Value = "True" Then
If rng1 Is Nothing Then
Set rng1 = cell
Else
Set rng1 = Union(rng1, cell)
End If
End If
Next
If Not rng1 Is Nothing Then
rng1.Range("B1:H1").Copy Destination:=Worksheets("Sheet2").Range("B2")
End If

copying multiple row to a new sheet
 

why dont u try using this approach:
Use your For loop to find all "true" values,
then use X = Cell.row to identify the Row,
then use Rows(x). Copy destination:=Worksheets("Sheet2").rows(x

----- still stuck wrote: ----

I got my code working where it copies a row and moves it over to the other sheet, but if I have multiple rows to move over it only moves the first row that is true, but not the others. How can I get it to move every row that is true over to a new sheet. Here's my code

Dim rng As Range, cell As Range, rng1 As Rang
Set rng = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp)
Set rng1 = Nothin
For Each cell In rn
If cell.Value = "True" The
If rng1 Is Nothing The
Set rng1 = cel
Els
Set rng1 = Union(rng1, cell
End I
End I
Nex
If Not rng1 Is Nothing The
rng1.Range("B1:H1").Copy Destination:=Worksheets("Sheet2").Range("B2"
End I

copying multiple row to a new sheet
 

I tried using the code with this line
rng1.Copy Destination:=Worksheets("Sheet2").Range("B2"

but it still doesn't do what I need it to do. I'm really stuck on this. For the rows that are true, I need to move part of that row over to another sheet, and I've gotten it to the point where it moves the first row over, but then every other true in that column will not move over. If anybody has any other suggestions it would be greatly appreciated.

copying multiple row to a new sheet
 

Hi
if I understood you you would like to copy columns B:H for each row in
whcih column B 0 "True". If this is correct try

Sub foo()
Dim rng As Range, cell As Range, rng1 As Range
Set rng = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp))
Set rng1 = Nothing
For Each cell In rng
If cell.Value = "True" Then
If rng1 Is Nothing Then
Set rng1 = Range(cell, Cells(cell.row, "H"))
Else
Set rng1 = Union(rng1, Range(cell, Cells(cell.row, "H")))
End If
End If
Next
If Not rng1 Is Nothing Then
rng1.Copy Destination:=Worksheets("Sheet2").Range("B2")

End If
End Sub


--
Regards
Frank Kabel
Frankfurt, Germany

desperate wrote:
I tried using the code with this line:
rng1.Copy Destination:=Worksheets("Sheet2").Range("B2")

but it still doesn't do what I need it to do. I'm really stuck on
this. For the rows that are true, I need to move part of that row
over to another sheet, and I've gotten it to the point where it moves
the first row over, but then every other true in that column will not
move over. If anybody has any other suggestions it would be greatly
appreciated.

copying multiple row to a new sheet
 

It works! Thank you so much for your help! How did you learn how to do all that so fast, I'm impressed.

copying multiple row to a new sheet
 

Hi
thanks for the feedback. Glad it works (as it was just a good guess)

--
Regards
Frank Kabel
Frankfurt, Germany

desperate wrote:
It works! Thank you so much for your help! How did you learn how to
do all that so fast, I'm impressed.