Code:
Sub deleteduplicate()
'define variables
Dim RowNum As Long
Dim LastRow As Long
Dim i As Integer
Dim j As Integer
'turn off screen updating
Application.ScreenUpdating = False
'start below titles and make full selection of data
RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A5", Cells(LastRow, 8)).Select

'For loop for all rows in selection with cells
For Each Row In Selection
    With Cells
 
           For i = 2 To 8
           For j = 1 To 500
           If Cells(RowNum, 1) = Cells(RowNum + j, 1) Then
           If IsEmpty(Cells(RowNum, i)) Then
           If IsEmpty(Cells(RowNum + j, i)) Then
           Cells(RowNum, i).Value = ""
           Else
           Cells(RowNum + j, i).Copy Destination:=Cells(RowNum, i)
            Rows(RowNum + j).EntireRow.Delete
            End If
            End If
            End If
            
            Next
            Next
        
   End With
'increase rownum for next test
RowNum = RowNum + 1
Next Row
'turn on screen updating
Application.ScreenUpdating = True

End Sub