search and list out multi data from a different file cross table

Question

I am trying to search for values listed in a column from multiple sheets in other Excel workbook. If Excel finds a match, I would like it to check the cell of other columns on the left of the match cell on the same row as the match data. If the cell is numeric, return the column top value, cell value in the new sheet of the workbook that run the vba.

Here is what I have done so far. As the item may not be in the same column in all sheets, a and b are for searching in all cells in the sheet. The code below have created new sheet, the first row, and opened the Excel workbook, then run-time error 1004: Application-defined or object-defined error occur.

the data in other Excel workbook "POINT TEST.xlsx":

Sub listout()
    Dim ws As Worksheet
    Dim Item As String, cellvalue As String
    Dim fname As String, ftype As String, rpno As Long
    Dim Totalsheets As Long, Totalopensheets As Long, lastRow As Long, lastColumn As Long
    Dim i As Long, a As Long, b As Long, c As Long, itemnum As Long, itemcount As Long
    
    
    Totalsheets = ThisWorkbook.Worksheets.Count
    Dim newsheet As Worksheet
    Set newsheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(Totalsheets))
    newsheet.Name = "Item"
    newsheet.Range("A1").Value = "Item"
    newsheet.Range("B1").Value = "Function"
    newsheet.Range("C1").Value = "Type"
    newsheet.Range("D1").Value = "No."
    Dim rown As Long
    itemnum = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    rown = 1
    
    Set otherbook = Workbooks.Open("C:\Users\Administrator\Desktop\LongLong\TKS\Test\POINT TEST.xlsx")
    For itemcount = 2 To itemnum
    Item = ThisWorkbook.Sheets(1).Range("A" & itemcount).Value

    
    
    Totalopensheets = Workbooks("POINT TEST.xlsx").Sheets.Count
    
    For i = 1 To Totalopensheets
        If Workbooks("POINT TEST.xlsx").Sheets(i).Name <> newsheet.Name Then ' skip newsheet
            lastRow = Workbooks("POINT TEST.xlsx").Sheets(i).Cells("A" & Rows.Count).End(xlUp).Row
            lastColumn = Workbooks("POINT TEST.xlsx").Sheets(i).Cells(2, Sheets(i).Columns.Count).End(xlToLeft).Column
            For a = 1 To lastColumn
                For b = 1 To lastRow
                    cellvalue = Workbooks("POINT TEST.xlsx").Sheets(i).Cells(b, a).Value
                    If Item = cellvalue Then
                        For c = 1 To lastColumn
                            If IsNumeric(Workbooks("POINT TEST.xlsx").Sheets(i).Cells(b, c).Value) And Not IsEmpty(Workbooks("POINT TEST.xlsx").Sheets(i).Cells(b, c).Value) Then
                                rown = rown + 1
                                fname = Workbooks("POINT TEST.xlsx").Sheets(i).Cells(2, c).Value
                                ftype = Workbooks("POINT TEST.xlsx").Sheets(i).Cells(1, c).Value
                                rpno = Workbooks("POINT TEST.xlsx").Sheets(i).Cells(b, c).Value
                                ' populate ftype and fname for blank cell
                                If Len(ftype) = 0 Then
                                    ftype = Workbooks("POINT TEST.xlsx").Sheets(i).Cells(1, c).End(xlToLeft).Value
                                End If
                                If Len(fname) = 0 Then fname = ftype
                                newsheet.Range("A" & rown).Value = Item
                                newsheet.Range("B" & rown).Value = fname
                                newsheet.Range("C" & rown).Value = ftype
                                newsheet.Range("D" & rown).Value = rpno
                            End If
                        Next c
                    End If
                Next b
            Next a
        End If
    Next i
    
    Next itemcount
    Workbooks("POINT TEST.xlsx").Close SaveChanges:=False
End Sub

This is the sheet of items required to search and list in workbook that run vba:

i would like the result in new sheet like below:

Answer 1

This should be close:

Sub listout()
    Dim ws As Worksheet, lastRow As Long, lastColumn As Long, Item As String
    Dim col As Long, v, c As Range, otherbook As Workbook, outRow As Range
    Dim wsList As Worksheet, newsheet As Worksheet, wb As Workbook, rw As Range
    
    Set wb = ThisWorkbook
    Set newsheet = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    newsheet.Name = "Item"
    newsheet.Range("A1:D1").Value = Array("Item", "Function", "Type", "No.") 'headers
    Set outRow = newsheet.Range("A2:D2") 'first output row
    
    Set otherbook = Workbooks.Open("C:\Users\Administrator\Desktop\LongLong\TKS\Test\POINT TEST.xlsx")
    
    Set wsList = wb.Worksheets(1)  'search values are here
    For Each c In wsList.Range("A2:A" & wsList.Cells(Rows.Count, "A").End(xlUp).Row).Cells
        Item = c.Value
        For Each ws In otherbook.Worksheets    'loop all worksheets
            If ws.Name <> newsheet.Name Then   'except for "Item"
                lastRow = ws.Cells("A" & ws.Rows.Count).End(xlUp).Row
                lastColumn = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
                
                For Each rw In ws.Range("A3", ws.Cells(lastRow, lastColumn)).Rows 'loop over rows of data
                    If rw.Cells(1).Value = Item Then  'match?
                        For col = 2 To lastColumn     'check rest of row
                            v = rw.Cells(col).Value
                            If Len(v) > 0 And IsNumeric(v) Then
                                outRow.Value = _
                                    Array(Item, ws.Cells(2, col).MergeArea.Cells(1).Value, _
                                          ws.Cells(1, col).MergeArea.Cells(1).Value, v)
                                    
                                Set outRow = outRow.Offset(1) 'next output row
                            End If   'is numeric value
                        Next col
                    End If   'Item match
                Next rw
            End If   'ws name is OK
        Next ws   'next worksheet to search
    Next c   'next lookup value
    
    otherbook.Close SaveChanges:=False
End Sub