Merging specific cells in rows on certain columns

Please see below before and after.  If this is not what you anticipate please provide more detail.  Please note in order for these procedures to work you will need to sort by Project in column B:

 

I believe you can use one of these two macros to accomplish your task:

 

Sub MergeAtoE()

    Dim LRow As Long
    Dim RowCnt As Integer
    Dim LngLp As Long
    Dim myCellString As String

    Application.DisplayAlerts = False 'Turn off pop up messages
    
    With ActiveSheet
        'Define last row based on data in column B
        LRow = .Cells(Rows.Count, "B").End(xlUp).Row
    
        For LngLp = 2 To LRow
            'Get Project Row Count
            RowCnt = Application.CountIf(.Range("B2:B" & LRow), .Range("B" & LngLp).Value)
            If RowCnt = 4 Then
                'Note when merging cells A to E the value in column A is the only one that will be kept
                .Range("A" & LngLp & ":E" & LngLp).Merge 'Merge Cells....
                .Range("A" & LngLp + 1 & ":E" & LngLp + 1).Merge 'Merge Cells....
                .Range("A" & LngLp + 2 & ":E" & LngLp + 2).Merge 'Merge Cells....
                .Range("A" & LngLp + 3 & ":E" & LngLp + 3).Merge 'Merge Cells....
                
                LngLp = LngLp + 3
            End If
            
        Next LngLp
        
        Application.DisplayAlerts = False 'Turn on pop up messages
    
    End With

End Sub

Sub CombineValuesThenMergeAtoE()

    Dim LRow As Long
    Dim RowCnt As Integer
    Dim LngLp As Long
    Dim myCellString As String

    Application.DisplayAlerts = False 'Turn off pop up messages
    
    With ActiveSheet
        'Define last row based on data in column B
        LRow = .Cells(Rows.Count, "B").End(xlUp).Row
    
        For LngLp = 2 To LRow
            'Get Project Row Count
            RowCnt = Application.CountIf(.Range("B2:B" & LRow), .Range("B" & LngLp).Value)
            If RowCnt = 4 Then
                'If you wish to merge all the values together and then merge the 5 cells use this instead
                .Range("A" & LngLp) = .Range("A" & LngLp) & .Range("B" & LngLp) & .Range("C" & LngLp) & .Range("D" & LngLp) & .Range("E" & LngLp)
                .Range("A" & LngLp & ":E" & LngLp).Merge 'Merge Cells....
                .Range("A" & LngLp + 1) = .Range("A" & LngLp + 1) & .Range("B" & LngLp + 1) & .Range("C" & LngLp + 1) & .Range("D" & LngLp + 1) & .Range("E" & LngLp + 1)
                .Range("A" & LngLp + 1 & ":E" & LngLp + 1).Merge 'Merge Cells....
                .Range("A" & LngLp + 2) = .Range("A" & LngLp + 2) & .Range("B" & LngLp + 2) & .Range("C" & LngLp + 2) & .Range("D" & LngLp + 2) & .Range("E" & LngLp + 2)
                .Range("A" & LngLp + 2 & ":E" & LngLp + 2).Merge 'Merge Cells....
                .Range("A" & LngLp + 3) = .Range("A" & LngLp + 3) & .Range("B" & LngLp + 3) & .Range("C" & LngLp + 3) & .Range("D" & LngLp + 3) & .Range("E" & LngLp + 3)
                .Range("A" & LngLp + 3 & ":E" & LngLp + 3).Merge 'Merge Cells....
                LngLp = LngLp + 3
            End If
            
        Next LngLp
        
        Application.DisplayAlerts = False 'Turn on pop up messages
    
    End With

End Sub