Code: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
Bookmarks