Find word and if number appears below word then copy

Might need to change the sheet names in the code on the first two lines, you never really specified what the first sheet is named.

Sub ScabbyDog()
Set ws1 = Sheets("Sheet1") ' The searched sheet
Set ws2 = Sheets("Sheet2") ' The pasted to sheet
SearchFor = ws1.Range("D1").Value
With ws1.Range("A:A")
    Set c = .Find(SearchFor, lookat:=xlWhole, MatchCase:=False)
    If Not c Is Nothing Then
        FirstAdd = c.Address
        Do
        If Val(c.Offset(1, 0).Value) = Int(Val(c.Offset(1, 0).Value)) Then
            ws1.Range(ws1.Cells(c.Row + 1, 2), ws1.Cells(c.Row + 16, 2)).Copy
            ws2.Range("Z1").PasteSpecial Transpose:=True
            Application.CutCopyMode = False
            Exit Sub
        End If
        Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAdd
        MsgBox ("Value in D1 was found, but with no whole number one cell below")
        Exit Sub
    Else
        MsgBox ("Value in D1 was not found")
    End If
End With
End Sub

@Walruss That works BUT it doesn't take into account that there has to be a number found directly below the cell where D1 is found in column A before doing the copying and pasting. Once that has been added then it's perfect. Any idea how to add that clause?

@John - That works but if the first time it finds the word and it has no number below it then it stops. It needs to keep searching until it finds a number under the word, then stop looping.

Try the code I posted above

That works BUT it doesn't take into account that there has to be a number found directly below the cell where D1 is found in column A before doing the copying and pasting.

It does evaluate that at this line, which works on my test sheet:

If Val(c.Offset(1, 0).Value) = Int(Val(c.Offset(1, 0).Value)) Then

If it's not working for you, can you post a sample data set where the evaluation fails?

Sub ScabbyDog()
Set ws1 = Sheets("Sheet1") ' The searched sheet
Set ws2 = Sheets("Sheet2") ' The pasted to sheet
SearchFor = ws1.Range("D1").Value
With ws1.Range("A:A")
    Set c = .Find(SearchFor, lookat:=xlWhole, MatchCase:=False)
    If Not c Is Nothing Then
        FirstAdd = c.Address
        Do
        If Val(c.Offset(1, 0).Value) = Int(Val(c.Offset(1, 0).Value)) Then
            ws1.Range(ws1.Cells(c.Row + 1, 2), ws1.Cells(c.Row + 16, 2)).Copy
            ws2.Range("Z1").PasteSpecial Transpose:=True
            Application.CutCopyMode = False
        End If
        Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAdd
        Exit Sub
    End If
MsgBox ("Value in D1 was not found, or no whole number was found underneath it.")
End With

End Sub