彙整工作表C3:
=VLOOKUP($A3,INDIRECT($B3&"!$A$3:$D$5"),COLUMN()-1,0)
向右複製公式到D3:E3。

把彙整變成 result, 另外表頭(料號,站別....)那些要在第一行開始
以下是 vba sql (我是初學), 送兩個給你,自己試試

Sub sample_1()
    
    Dim Conn As Object, Rst As Object
    Dim strConn As String, strSQL As String
    Dim i As Integer, PathStr As String
    Set Conn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
    PathStr = ThisWorkbook.FullName
    Select Case Application.Version * 1
    Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
    Conn.Open strConn
    
    If Worksheets("result").[a1048576].End(xlUp).Row > 1 Then
        Worksheets("result").Range("a2:m" & Worksheets("result").[a1048576].End(xlUp).Row).Clear
    End If

    Set dc = CreateObject("Scripting.Dictionary")
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "Result" Then
            For j = 2 To ws.[a1048576].End(xlUp).Row
                With dc
                    If dc.exists(ws.Cells(j, "a").Value) = False Then
                        dc.Add ws.Cells(j, "a").Value & "," & ws.Name, 1
                    End If
                End With
            Next
        End If
    Next
    Worksheets("result").[a2].Resize(UBound(dc.keys) + 1, 1) = WorksheetFunction.Transpose(dc.keys)
    
    Worksheets("Result").Sort.SortFields.Clear
    Worksheets("Result").Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("Result").Sort
        .SetRange Worksheets("Result").Range("a2:a7")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For i = 2 To Worksheets("result").[a1048576].End(xlUp).Row
        Worksheets("result").Cells(i, "a").Resize(1, 2) = Split(Worksheets("result").Cells(i, "a"), ",")
        For j = 3 To Worksheets("result").[zz1].End(xlToLeft).Column
            strSQL = "Select `" & Worksheets("result").Cells(1, j) & "` FROM [" & Worksheets("result").Cells(i, "b") & "$] where `料號`='" & Worksheets("result").Cells(i, "a") & "'" & ""
            Set Rst = Conn.Execute(strSQL)
            If Rst.EOF = False And Rst.BOF = False Then
                If IsNull(Rst.Fields(0).Value) = False Then
                    Worksheets("result").Cells(i, j) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Conn.Execute(strSQL).getrows))(1)
                End If
            End If
        Next
    Next
    
    Conn.Close
    
End Sub
Sub sample_2()
    
    Dim Conn As Object, Rst As Object
    Dim strConn As String, strSQL As String
    Dim i As Integer, PathStr As String
    Set Conn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
    PathStr = ThisWorkbook.FullName
    Select Case Application.Version * 1
    Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
    Conn.Open strConn
    
    If Worksheets("result").[a1048576].End(xlUp).Row > 1 Then
        Worksheets("result").Range("a2:m" & Worksheets("result").[a1048576].End(xlUp).Row).Clear
    End If
    
    Set dc = CreateObject("Scripting.Dictionary")
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "Result" Then
            For j = 2 To ws.[a1048576].End(xlUp).Row
                With dc
                    If dc.exists(ws.Cells(j, "a").Value) = False Then
                        dc.Add ws.Cells(j, "a").Value, 1
                    End If
                End With
            Next
        End If
    Next
    Worksheets("result").[a2].Resize(UBound(dc.keys) + 1, 1) = WorksheetFunction.Transpose(dc.keys)
    
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "Result" Then
            For i = 2 To Worksheets("result").[a1048576].End(xlUp).Row
                For j = 3 To ws.[zz1].End(xlToLeft).Column
                    strSQL = "Select `" & Worksheets("result").Cells(1, j) & "` FROM [" & ws.Name & "$] where `料號`='" & Worksheets("result").Cells(i, "a") & "'" & ""
                    Set Rst = Conn.Execute(strSQL)
                    If Rst.EOF = False And Rst.BOF = False Then
                        If IsNull(Rst.Fields(0).Value) = False Then
                            Worksheets("result").Cells(i, j) = Worksheets("result").Cells(i, j) + WorksheetFunction.Transpose(WorksheetFunction.Transpose(Conn.Execute(strSQL).getrows))(1)
                        End If
                    End If
                Next
            Next
        End If
    Next
    
    Conn.Close
    
End Sub