Give this a try...

Sub CopyStuff()
   Dim rngToSearch As Range
   Dim rngFound As Range
   Dim rngFoundAll As Range
   Dim strFirstAddress  As String
   
   Set rngToSearch = Sheets("Sheet2").Columns("D")
   Set rngFound = rngToSearch.Find(What:="6*", _
                                   LookAt:=xlWhole, _
                                   LookIn:=xlFormulas)
   If Not rngFound Is Nothing Then
       Set rngFoundAll = rngFound
       strFirstAddress = rngFound.Address
       Do
           Set rngFoundAll = Union(rngFound, rngFoundAll)
           Set rngFound = rngToSearch.FindNext(rngFound)
       Loop Until rngFound.Address = strFirstAddress
       rngFoundAll.Offset(0, 1).Copy Sheets("Sheet1").Range("A32")
   End If
End Sub