combine two sheet depend on sequence of first sheet

Hi fafa

Welcome to the Forum!

This code is in the attached and appears to do as you require. Let me know of issues.

Option Explicit
Sub Combine()
    Dim LCpl As Long
    Dim LCty As Long
    Dim LCr As Long
    Dim wsR As Worksheet
    Dim wsP As Worksheet
    Dim wsT As Worksheet
    Dim cel As Range
    Dim rng As Range
    Dim cell As Range
    Dim rng1 As Range
    Dim LRp As Long
    Dim LRr As Long

    Set wsP = Sheets("PLAN")
    Set wsT = Sheets("TYPE")

    LCpl = wsP.Cells(1, Columns.Count).End(xlToLeft).Column
    LCty = wsT.Cells(1, Columns.Count).End(xlToLeft).Column

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("RESULT").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "RESULT"
    Set wsR = Sheets("RESULT")

    With wsR
        .Cells(1, 1).Resize(1, LCty).Value = wsT.Cells(1, 1).Resize(1, LCty).Value
        LCr = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        .Cells(1, LCr).Resize(1, LCpl).Value = wsP.Cells(1, 3).Resize(1, LCpl).Value
        .Cells(1, LCr).Resize(1, LCpl).NumberFormat = "d-mmm"
        wsT.UsedRange.Offset(1, 0).Copy
        .Cells(2, 1).PasteSpecial
        Application.CutCopyMode = False
    End With

    For Each cel In wsP.Range(("B2"), wsP.Range("B2").End(xlDown))
        With wsR
            .AutoFilterMode = False
            .Range(("C1"), .Range("C1").End(xlDown)).AutoFilter Field:=1, _
                    Criteria1:=cel
            Set rng = wsR.AutoFilter.Range.Columns(1)
            Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 1)
            Set rng1 = rng.SpecialCells(xlVisible)
            For Each cell In rng1
                cell.Offset(0, 2).Resize(1, LCpl).Value = cel.Offset(0, 1).Resize(1, LCpl).Value
            Next
            .AutoFilterMode = False
        End With
    Next cel

    With wsP
        LRp = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        Application.AddCustomList ListArray:=.Range("A2:A" & LRp)
    End With

    With wsR
        LRr = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        LCr = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(1, 1), .Cells(LRr, LCr)).Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
                Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    End With
    Application.DeleteCustomList Application.CustomListCount
    Application.ScreenUpdating = True
End Sub