Untitled

Sub TransformData()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim currentProductCode As String
    Dim currentProductName As String
    
    ' Define the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Find the last row of data in the sheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Initialize with the first product code and name
    currentProductCode = ws.Range("D9").Value
    currentProductName = ws.Range("E9").Value
    
    ' Loop through each row starting from row 9
    For i = 9 To lastRow
        ' Check if there's a new product code and name
        If ws.Cells(i, 4).Value <> "" Then
            currentProductCode = ws.Cells(i, 4).Value
            currentProductName = ws.Cells(i, 5).Value
        End If
        
        ' Insert the current product code and name in columns A and B
        ws.Cells(i, 1).Value = currentProductCode
        ws.Cells(i, 2).Value = currentProductName
        
        ' Shift the date and time columns (starting from column B) two columns to the right
        ws.Cells(i, 3).Resize(1, 7).Value = ws.Cells(i, 1).Resize(1, 7).Offset(0, 2).Value
        
        ' Clear the old location of date and time columns
        ws.Cells(i, 5).Resize(1, 7).ClearContents
    Next i
End Sub