Find range of numbers in a column.

  • Thread starter Thread starter RayD
  • Start date Start date
R

RayD

Sub findandcopy()
Sheets("Sheet2").Range("2:2000").Clear
Sheets("Sheet2").Range("2:2000").RowHeight = 12.75
Columns("H").Find("x").EntireRow.Copy _
Sheets("sheet2").Range("a3")
End Sub

The above is complements of Don Guillett

Hello everyone

What I am trying to do here is get this macro to look in every cell in
sheet1 column "H5:H2000" and then find "any" number within that range
from (-1 to 46) if found, then copy the entire row of each instance to
sheet2. Any help or direction would be appreciated.
Thanks
 
one way:

Public Sub FindAndCopy()
Dim cell As Range
Dim destRange As Range
Dim sourceRange As Range
Set destRange = Sheets("Sheet2").Range("A2")
With destRange.Resize(1999)
.EntireRow.Clear
.RowHeight = 12.75
End With
With ActiveSheet
Set sourceRange = Intersect( _
.Range("H5:H2000"), .UsedRange)
End With
If Not sourceRange Is Nothing Then
For Each cell In sourceRange
With cell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
If .Value >= -1 And .Value <= 46 Then
.EntireRow.Copy destRange
Set destRange = destRange.Offset(1, 0)
End If
End If
End If
End With
Next cell
End If
End Sub
 
Thanks again... works perfectly!

one way:

Public Sub FindAndCopy()
Dim cell As Range
Dim destRange As Range
Dim sourceRange As Range
Set destRange = Sheets("Sheet2").Range("A2")
With destRange.Resize(1999)
.EntireRow.Clear
.RowHeight = 12.75
End With
With ActiveSheet
Set sourceRange = Intersect( _
.Range("H5:H2000"), .UsedRange)
End With
If Not sourceRange Is Nothing Then
For Each cell In sourceRange
With cell
If Not IsEmpty(.Value) Then
If IsNumeric(.Value) Then
If .Value >= -1 And .Value <= 46 Then
.EntireRow.Copy destRange
Set destRange = destRange.Offset(1, 0)
End If
End If
End If
End With
Next cell
End If
End Sub
Click to expand...
 
Back
Top