copying only rows in a range w/ vales to another range

[daseffects]

Say I have a range of values that has various data based on user inputs of a model

Sheet1 =
Test1 1 2 3
Test2 0 0 0
Test3 -3 -2 -1

I'm currently copying this over with

Sheets("sheet1&quot.Range("a1&quot.Resise(3,4) = Sheets("sheet2&quot.Range("a1:d3&quot.value

What I would like to do is only copy the rows that have any data in them (positive or negative values) so that the pasted range would like this

Sheet2
Test1 1 2 3
Test3 -3 -2 -1

I'm assuming it would have to be sum sort of conditional loop. If sum row1 <>0,then copy. But that sort of code is a bit beyond my current skill level.

DAS

 

[Bowers74]

This is a bit crude, but it should do the trick:

Sub CopyValues()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row + 1
Range("A1").Select
Do Until ActiveCell.Row = LastRow
    If Application.WorksheetFunction.Sum(Range(ActiveCell, _
        ActiveCell.End(xlToRight))) = 0 Then
        ActiveCell.EntireRow.Hidden = True
    End If
    ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
Range("A1").SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Sheets("Sheet2").Range("A1")
Sheets("Sheet1").Cells.EntireRow.AutoFit
Sheets("Sheet2").Select
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Rows with values ahve been copied to: " & ActiveSheet.Name
End Sub

If you would rather have easier refernces to your sheets other than Sheets(&quot;Sheet1) read my FAQ:

faq707-4090.

I hope this helps!


Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[daseffects]

Mike thanks for the above. I was able to get the below w/ some help from a friend.


Sub moverows()
Dim i As Integer
Dim myrange As Range
'set anchor cell as sheet1 a1
Set myrange = ActiveSheet.Cells(1, 1).CurrentRegion
For Each celrow In myrange.Rows
' if there are any numbers in the row copy the whole row
If Application.Max(celrow) > 0 Or Application.Min(celrow) < 0 Then
i = i + 1
Sheets(2).Cells(i, 1).Resize(1, myrange.Columns.Count).Value = celrow.Value
Else
End If
Next celrow
Sheets(1).Cells(1, 1).Select
End Sub