Hi drop all this in a standard module, the code will look at every 3rd
column up to a maximum of all used coulmns and work up from the last
used cell when it finds a blank it will delete the cells for all 3
columns in that row then it will move 3 columns over and do the same!

Sub delete_blanks()
Dim Rng As Range, MyCell As Range
Dim i As Long, r As Long
Dim C1 As String, C2 As String
For i = 3 To ActiveSheet.UsedRange.Columns.Count Step 3
C1 = ColumnLetter(i - 0)
C2 = ColumnLetter(i - 2)
For r = Range(C1 & Rows.Count).End(xlUp).Row To 1 Step -1
If Range(C1 & r).Value = "" Then
Range(C1 & r & ":" & C2 & r).Delete shift:=xlUp
End If
Next r
Next i
End Sub
Function ColumnLetter(ColumnNumber As Integer) As String
If ColumnNumber 26 Then

ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
ColumnLetter = Chr(ColumnNumber + 64)
End If
End Function


--
The Code Cage Team

Regards,
The Code Cage Team
www.thecodecage.com
------------------------------------------------------------------------
The Code Cage Team's Profile: http://www.thecodecage.com/forumz/member.php?userid=2
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=7373