Create Table with cells that contain data in another row for master sheet

[surkdidat]

DATA_SHEET

ROW	COLUMN B	COLUMN I	COLUMN S	COLUMN T	COLUMN U	COLUMN V	COLUMN W	COLUMN X
1	EAN	PRODUCT_ID	BRAND_NAME	PACK_QTY	PACK_TYPE	PRODUCT_WEIGHT	HEIGHT	WIDTH
2	5500550055005	12345	ABCDE	1	SACHET	500g	100mm	50mm
3	6622553366264	68916	FGHIJ	5	SACHET	1000g	250mm	85mm
4	9656126694444	52633	IMJKK			250g	20	33

PUBLISH SHEET

ROW	COLUMN A	COLUMN C	COLUMN D	COLUMN E	COLUMN F	COLUMN G	COLUMN H
1	ATT_1	ATT_2	ATT_3	ATT_4	ATT_5	ATT_6	ATT_7
2	12345	BRAND_NAME	PRODUCT_WEIGHT
3	68916	BRAND_NAME	PACK_QTY	PACK_TYPE
4	52633	BRAND_NAME	PRODUCT_WEIGHT	HEIGHT	WIDTH
5

END RESULT

ROW	COLUMN B	COLUMN I	COLUMN S	COLLUMN T	COLUMN U	COLUMN V	COLUMN W	COLUMN X
1	EAN	PRODUCT_ID	BRAND_NAME	PACK_QTY	PACK_TYPE	PRODUCT_WEIGHT	HEIGHT	WIDTH
2	5500550055005	12345	ABCDE			500g
3	6622553366264	68916	FGHIJ	1	SACHET
4	9656126694444	52633	IMJKKK			250g	20	33

OK... A tad complicated to explain I think, but

In "Data Sheet" is the initial Data
In "Publish Sheet" is the data I need to publish based on the EAN/PRODUCT ID (In the row) and what columns I need to capture
In "End Result" is the data I need to come across (needs to be in the exact table format as "Data Sheet" omitting any data in cells that are not in the "Publish SHeet" tab

Data_Sheet = There are Column S to Column AEI with potential data in. Up to row 6064 in the Data_Sheet

Publish SHeet - Columns C to Column AD (Rows 2 to 227) have potential matches in (Some rows may only have 1 or 2 to be published, others could have 50)

 

[DanteAmor]

In the sheet "End Result" should be 5, correct?

 

[DanteAmor]

If the structure of your data is like your examples, then try the following:

Sub CreateTable()
  Dim shD As Worksheet, shP As Worksheet, shR As Worksheet
  Dim c As Range, f As Range
  Dim j As Long, k As Long, m As Long, r As Long
  Dim v As Variant
  Application.ScreenUpdating = False
  Set shD = Sheets("Data")      'Set the name of your sheets
  Set shP = Sheets("Publish")
  Set shR = Sheets("Result")
  
  k = 1
  For Each c In shD.Range("I2", shD.Range("I" & Rows.Count).End(3))
    Set f = shP.Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      r = f.Row
      k = k + 1
      shR.Cells(k, "B").Value = shD.Range("B" & c.Row).Value
      shR.Cells(k, "I").Value = c.Value
      
      For j = 3 To shP.Cells(r, Columns.Count).End(1).Column
        Set f = shD.Rows(1).Find(shP.Cells(r, j).Value, , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          v = shD.Cells(r, f.Column).Value
          Set f = shR.Rows(1).Find(shP.Cells(r, j).Value, , xlValues, xlWhole, , , False)
          If Not f Is Nothing Then shR.Cells(k, f.Column).Value = v
        End If
      Next
    End If
  Next
End Sub