Search for a value and if the value is found copy the whole row. And repeat the proces

Hello,

I am trying to do two things

First in the sheet "All Numbers" using the value in column A, search this value in the sheet "internal numbers" in column A.
If the value is found in the sheet "internal numbers" write the word "OCCUPIED" in column E of the sheet "All Numbers"
Else if the value is not found in the sheet "internal numbers" write the word "FREE" in column E of the sheet "All Numbers" and repeat for all the rows in sheet "All numbers""until the value in column A is empty

Second
First in the sheet "All Numbers" using the value in column A, search this value in the sheet "internal data" in column A.
If the value is found in the sheet "internal data" copy the whole row (A:AX) total of 50 columns from the sheet "internal data" and append it to the row "All numbers" from column F ( so column A from "internal data" becomes colum F in sheet "All numbers"
Else if the value is not found in the sheet "internal numbers" goto the next row and repeat for all the rows in sheet "All numbers""until the value in column A is empty.


Many thanks in advance


Regards Kevin

Give this a try

Option Explicit
Sub FindNumbers()
 Dim ws As Worksheet, wsMaster As Worksheet
 Dim rngNum As Range, cellPtr As Range
 Dim FoundCell As Range
 Dim LastRow As Long, iCol As Long
 Dim arrResults() As Variant

    Set wsMaster = Worksheets("All numbers")
    Set ws = Worksheets("Internal numbers")
    
    LastRow = GetLastRow(CStr(wsMaster.Name), "A")
    Set rngNum = wsMaster.Range("A2:A" & LastRow)
    
    ReDim arrResults(1 To 5, 1 To 1)
    For Each cellPtr In rngNum
        LastRow = GetLastRow(CStr(ws.Name), "A")
        Set FoundCell = ws.Range("A2:A" & LastRow).Find(What:=cellPtr.Value, LookAt:=xlWhole)
        If Not FoundCell Is Nothing Then
            wsMaster.Cells(cellPtr.Row, "E") = "OCCUPIED"
            For iCol = 1 To 5
                arrResults(iCol, UBound(arrResults, 2)) = wsMaster.Cells(cellPtr.Row, iCol)
            Next
            ReDim Preserve arrResults(1 To 5, 1 To UBound(arrResults, 2) + 1)
        Else
            wsMaster.Cells(cellPtr.Row, "E") = "FREE"
        End If
    Next cellPtr
    
    
    Worksheets("Results_found").Cells.Delete
    arrResults = WorksheetFunction.Transpose(arrResults)
    Worksheets("Results_found").Range("A2").Resize(UBound(arrResults), UBound(arrResults, 2)) = arrResults
    Erase arrResults
    
    arrResults = wsMaster.Range("A1:E1")
    Worksheets("Results_found").Range("A1:E1") = arrResults
    Erase arrResults
    
    Set wsMaster = Nothing
    Set ws = Nothing
    Set rngNum = Nothing
    Set cellPtr = Nothing
    Set FoundCell = Nothing
End Sub


Private Function GetLastRow(WhatSheet As String, WhatColumn As String) As Long
    If Application.Version <= 11 Then
        GetLastRow = Worksheets(WhatSheet).Cells(Rows.Count, WhatColumn).End(xlUp).Row
    Else
        GetLastRow = Worksheets(WhatSheet).Cells(Rows.CountLarge, WhatColumn).End(xlUp).Row
    End If
End Function

Not sure if this is what your meaning or not

Option Explicit
Sub freevsaccupied()
 Dim ws As Worksheet, ws2 As Worksheet, wsMaster As Worksheet
 Dim rngNum As Range, cellPtr As Range
 Dim FoundCell As Range
 Dim LastRow As Long, iCol As Long
 Dim arrResults() As Variant

 
    Set wsMaster = Worksheets("All numbers")
    Set ws = Worksheets("Internal numbers")
    Set ws2 = Worksheets("Internal Data")
    
    LastRow = GetLastRow(CStr(wsMaster.Name), "A")
    Set rngNum = wsMaster.Range("A2:A" & LastRow)
    
    ReDim arrResults(1 To 5, 1 To 1)
    
    For Each cellPtr In rngNum
        LastRow = GetLastRow(CStr(ws.Name), "A")
        Set FoundCell = ws.Range("A2:A" & LastRow).Find(What:=cellPtr.Value, LookAt:=xlWhole)
        If Not FoundCell Is Nothing Then
            wsMaster.Cells(cellPtr.Row, "E") = "OCCUPIED"
            For iCol = 1 To 5
                arrResults(iCol, UBound(arrResults, 2)) = wsMaster.Cells(cellPtr.Row, iCol)
            Next
            ReDim Preserve arrResults(1 To 5, 1 To UBound(arrResults, 2) + 1)
        Else
            wsMaster.Cells(cellPtr.Row, "E") = "FREE"
        End If
        
        Set FoundCell = Nothing
        LastRow = GetLastRow(CStr(ws2.Name), "A")
        Set FoundCell = ws2.Range("A2:A" & LastRow).Find(What:=cellPtr.Value, LookAt:=xlWhole)
        If Not FoundCell Is Nothing Then
              ws2.Range("A" & FoundCell.Row, "AX" & FoundCell.Row).Copy wsMaster.Cells(cellPtr.Row, "F")
        End If
    Next cellPtr
    
    
    Worksheets("Results_found").Cells.Delete
    arrResults = WorksheetFunction.Transpose(arrResults)
    Worksheets("Results_found").Range("A2").Resize(UBound(arrResults), UBound(arrResults, 2)) = arrResults
    Erase arrResults
    
    arrResults = wsMaster.Range("A1:E1")
    Worksheets("Results_found").Range("A1:E1") = arrResults
    Erase arrResults
    
    Set wsMaster = Nothing
    Set ws = Nothing
    Set rngNum = Nothing
    Set cellPtr = Nothing
    Set FoundCell = Nothing
End Sub


Private Function GetLastRow(WhatSheet As String, WhatColumn As String) As Long
    If Application.Version <= 11 Then
        GetLastRow = Worksheets(WhatSheet).Cells(Rows.Count, WhatColumn).End(xlUp).Row
    Else
        GetLastRow = Worksheets(WhatSheet).Cells(Rows.CountLarge, WhatColumn).End(xlUp).Row
    End If
End Function