split Tables into multiple Tables for multiple sheets with different structure & arranging

Public OriginRng As Range, BrandRng As Range
Sub Copy2Sheets()

    Dim src As Worksheet
    Dim trg As Worksheet
    Dim LastRow As Long, rcount As Long, srow As Long, lrow As Long
    Dim r As Long, c As Long
    
    Application.ScreenUpdating = False
    
    Set src = ThisWorkbook.Worksheets("tt")
    
    srow = 2
    
    With src
    
        .Activate
    
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set srcRng = .Range("A1:A" & LastRow)
        shtname = .Cells(srow, "A")                          ' First sheet
        
        rcount = WorksheetFunction.CountIf(srcRng, shtname)
        lrow = srow + rcount - 1
        
        Set trg = ThisWorkbook.Worksheets(shtname)
        hdr = Array("Item", "Brand", "Origin", "Qty")
        
        For r = srow To lrow
            For c = 6 To 7
            If Cells(r, c) <> "" Then
                Cells(r, 5) = Cells(r, 5) & " " & Cells(r, c)
                Cells(r, c) = ""
            End If
            Next c
        Next r
        
        trg.Range("A1").Resize(1, 4) = hdr
        .Range("H" & srow & ":H" & lrow).Copy Destination:=trg.Range("A2")
        .Range("E" & srow & ":E" & lrow).Copy Destination:=trg.Range("B2")
        .Range("C" & srow & ":C" & lrow).Copy Destination:=trg.Range("C2")
        .Range("B" & srow & ":B" & lrow).Copy Destination:=trg.Range("D2")
        
        Set BrandRng = trg.Range("B2:B" & rcount + 1)
        Set OriginRng = trg.Range("C2:C" & rcount + 1)
        Call Get_Origin
        
        '************************************************************************
        hdr = Array("Sr", "Item Code", "Accepted Quantity")
        
        srow = lrow + 1
        shtname = .Cells(srow, "A")                         ' Second sheet
        srow = srow + 1
        rcount = WorksheetFunction.CountIf(srcRng, shtname) - 1
        lrow = srow + rcount - 1
        
        Set trg = ThisWorkbook.Worksheets(shtname)
         
         trg.Range("A1").Resize(1, 3) = hdr
        .Range("B" & srow & ":B" & lrow).Copy Destination:=trg.Range("A2")
        .Range("C" & srow & ":C" & lrow).Copy Destination:=trg.Range("B2")
        .Range("F" & srow & ":F" & lrow).Copy Destination:=trg.Range("C2")
        
        For i = 1 To rcount
             trg.Range("B" & i + 1) = trg.Range("B" & i + 1) & " JAP"
             trg.Range("C" & i + 1) = Replace(trg.Range("C" & i + 1), "Unit", "")
         Next i
        
        '************************************************************************
        hdr = Array("Sr", "Descriptione", "Production", "Qty")
        
        srow = lrow + 1
        shtname = .Cells(srow, "A")                            ' Third Sheet
        srow = srow + 1
        rcount = WorksheetFunction.CountIf(srcRng, shtname) - 1
        lrow = srow + rcount - 1
        
        Set trg = ThisWorkbook.Worksheets(shtname)
        
         trg.Range("A1").Resize(1, 4) = hdr
        .Range("E" & srow & ":E" & lrow).Copy Destination:=trg.Range("A2")
        .Range("D" & srow & ":D" & lrow).Copy Destination:=trg.Range("B2")
        .Range("B" & srow & ":B" & lrow).Copy Destination:=trg.Range("C2")
        .Range("C" & srow & ":C" & lrow).Copy Destination:=trg.Range("D2")
        
        Set BrandRng = trg.Range("B2:B" & rcount + 1)
        Set OriginRng = trg.Range("C2:C" & rcount + 1)
        Call Get_Origin
    
    End With
    
    Application.ScreenUpdating = True

    End Sub
Sub Get_Origin()
Dim a, n As Integer, i As Integer, c As Range, Origin As String

a = Range("Short")
n = 0

For Each c In OriginRng

    n = n + 1
    For i = 1 To 7
     BrandRng(n) = Replace(BrandRng(n, 1), a(i, 1), "")
    Next i
    Origin = Application.WorksheetFunction.VLookup(c, Range("liss"), 2, False)
    BrandRng(n, 1).Value = Trim(BrandRng(n, 1).Value) & " " & Origin
    
Next c

End Sub

Merges Cells and then clears

I am sure Marc L will have some "smarter" code!