Public Sub ProcessData()Dim Lastrow As Long
Dim Nextrow As Long
Dim i As Long
Dim cell As Range
Application.ScreenUpdating = False
With ActiveSheet
.Range("E1:G1").Value = Array("Sheet name", "Clarity", "Color")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 5 To Lastrow
.Cells((i - 4) * 2, "E").Resize(2) = .Name
.Cells((i - 4) * 2, "F").Resize(2) = Application.Transpose(.Range("B4:C4"))
.Cells((i - 4) * 2, "G").Resize(2) = .Cells(i, "A").Value
.Cells((i - 4) * 2, "H").Resize(2) = .Range("A3").Value
.Cells((i - 4) * 2, "J").Resize(2) = Application.Transpose(.Cells(i, "B").Resize(, 2))
Next i
.Columns("E:J").AutoFit
.Columns("A:D").Delete
End With
Application.ScreenUpdating = True
End Sub