VB

Option Explicit Sub ExplodedDataToTable() Dim srcWsh As Worksheet Dim i As Long, r As Long On Error GoTo Err_ExplodedDataToTable Set srcWsh = ThisWorkbook.Worksheets(1) 'you can pass the name of worksheet i = 2 r = srcWsh.Range("D" & srcWsh.Rows.Count).End(xlUp).Row Do While i < r 'remove empty row If srcWsh.Range("A" & i) = "" And srcWsh.Range("B" & i) = "" And _ srcWsh.Range("C" & i) = "" And srcWsh.Range("D" & i) = "" Then srcWsh.Range("A" & i).EntireRow.Delete xlShiftUp r = r - 1 i = i - 1 GoTo SkipNext End If 'A is not empty If srcWsh.Range("A" & i) <> "" And srcWsh.Range("B" & i) = "" And _ srcWsh.Range("C" & i) = "" And srcWsh.Range("D" & i) = "" Then srcWsh.Range("B" & i & ":D" & i).Delete xlShiftUp r = r - 1 i = i - 1 GoTo SkipNext End If 'A & B is not empty If srcWsh.Range("A" & i) <> "" And srcWsh.Range("B" & i) <> "" And _ srcWsh.Range("C" & i) = "" And srcWsh.Range("D" & i) = "" Then srcWsh.Range("C" & i & ":D" & i).Delete xlShiftUp r = r - 1 i = i - 1 GoTo SkipNext End If 'A, B & C is not empty If srcWsh.Range("A" & i) <> "" And srcWsh.Range("B" & i) <> "" And _ srcWsh.Range("C" & i) <> "" And srcWsh.Range("D" & i) = "" Then srcWsh.Range("D" & i).Delete xlShiftUp r = r - 1 i = i - 1 GoTo SkipNext End If 'A, B & C is empty, D is not empty If srcWsh.Range("A" & i) = "" And srcWsh.Range("B" & i) = "" And _ srcWsh.Range("C" & i) = "" And srcWsh.Range("D" & i) <> "" Then srcWsh.Range("A" & i - 1 & ":C" & i - 1).Copy srcWsh.Range("A" & i) GoTo SkipNext End If 'A, B is empty, C & D is not empty If srcWsh.Range("A" & i) = "" And srcWsh.Range("B" & i) = "" And _ srcWsh.Range("C" & i) <> "" And srcWsh.Range("D" & i) <> "" Then srcWsh.Range("A" & i - 1 & ":B" & i - 1).Copy srcWsh.Range("A" & i) GoTo SkipNext End If 'A, is empty, B, C & D is not empty If srcWsh.Range("A" & i) = "" And srcWsh.Range("B" & i) <> "" And _ srcWsh.Range("C" & i) <> "" And srcWsh.Range("D" & i) <> "" Then srcWsh.Range("A" & i - 1).Copy srcWsh.Range("A" & i) GoTo SkipNext End If SkipNext: i = i + 1 Loop Exit_ExplodedDataToTable: On Error Resume Next Set srcWsh = Nothing Exit Sub Err_ExplodedDataToTable: MsgBox Err.Description, vbExclamation, Err.Number Resume Exit_ExplodedDataToTable End Sub

Where are you stuck?

What help do you need?

This is not a good question - we cannot work out from that little what you are trying to do.

Remember that we can't see your screen, access your HDD, or read your mind - we only get exactly what you type to work with. And we have no idea what you have tried, and where you need help with this.