Find data in one sheet copy them and paste them to another

[stef_nikop]

HELLO,

i have some data on one sheet1, more specifically company names and below them a specific number.

I want to use an inputbox that a company name will be entered, then find all of the same company name in sheet1 and each time the company name is found COPY the cell below the company name and paste it to another sheet, at a specific location.

Thanks, very much in advance

[stef_nikop]

help.xlsxi wrote this code but ity does no stop looping

Sub select_data() 
    Dim mysting As String 
    Dim foundcell As range 
    Dim range1 As range 
    Dim cell1 As range 
    Dim counter As Integer 
    counter = 3 
    mystring = InputBox("enter what to be found") 
    Sheets("data").Activate 
    Set range1 = ActiveSheet.range("a1:h31") 
     
    With range1 
        Set foundcell = range1.Find(What:=mystring, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 
        If Not foundcell Is Nothing Then 
            firstadress = foundcell.Address 
            Do 
                Set cell1 = foundcell 
                cell1.Copy 
                Sheets("select data").Activate 
                Cells(counter, 2).Select 
                ActiveSheet.Paste 
                counter = counter + 1 
                Set foundcell = .FindNext(foundcell) 
            Loop While Not foundcell Is Nothing And foundcell.Address <> firstaddress 
        End If 
    End With 
End Sub