Hi,

I have a very similar problem but want to copy all rows where a numerical
value in a given column is greater than 1, I also want to ensure that column
headings in the destination worksheet are preserved during the paste
operation. How should I modify the code below to achieve that?

Many thanks in advance.

Lu

"Rick Rothstein" wrote:

Give this macro a try (change the two Set statements for the Source and
Destination workbooks as appropriate)...

Sub CopyRowsWithNumbersInB()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("Sheet1")
Set Destination = Worksheets("Sheet2")
With Source
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "B").Value) And .Cells(X, "B").Value < "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "B")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "B"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A1")
End If
End With
End Sub

--
Rick (MVP - Excel)