Macro to find value and then copy associated range

[hnyb1]

Hi,

Using Excel 2003 I've tried to piece together a macro to find a cell in one
worksheet and the then set the range based on that found cell... copy and
paste to another worksheet. It's not quite working and I can't figure out
why. Any help would, once again, be greatly appreciated. Code is as follows

Sub addhatchinfo()
Worksheets("Hatchability Data").Activate

Dim FindWhat As String
Dim FoundCell As Range
Dim cpyrng As Range

FindWhat = InputBox("Enter the Tracking Number here")
Worksheets("Viability Data").Activate
'On Error Resume Next
Set FoundCell = Range("d:d").Find(what:=FindWhat, _
lookat:=xlPart, LookIn:=xlValues)
FoundCell.Activate
x = ActiveCell.Row
Set cpyrng = Range(Cells(x, "a"), Cells(x, "aj"))
Range(cpyrng).Select
Selection.Copy

Worksheets("Hatchability Data").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Paste
End Sub

Happy New Year to all!!

 

[Don Guillett]

NO selections necessary. Fire from anwhere in the workbook
Sub copytrackingnum()
Set ss = Sheets("sheet4")
Set ds = Sheets("sheet3")
dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row + 1
FindWhat = InputBox("Enter the Tracking Number here")

Set FoundCell = ss.Columns(4).Find(FindWhat, LookIn:=xlValues, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not FoundCell Is Nothing Then
'MsgBox FoundCell.Row
ss.Range(ss.Cells(FoundCell.Row, "a"), _
ss.Cells(FoundCell.Row, "aj")).Copy ds.Cells(dlr, 1)
End If
End Sub