Sub DDD()
Dim lngN As Long
Dim lngCol As Long

Cells.UnMerge
With ActiveSheet.UsedRange
lngCol = .Columns(.Columns.Count).Column
End With
For lngN = lngCol To 1 Step -1
If Application.CountA(Columns(lngN)) = 0 Then
Columns(lngN).Delete
End If
Next
End Sub
-----------
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Alex Sander" <Alex

wrote in message
Hello,
I am pulling out of Business Objects reports in excel, unfortunately the
reports come out almost normal. By abnormal I mean thet the various cells of
data are made of several merged columns. I need to write a macro to
automatically unmerge all cells in the sheet and then remove all blank
columns, leaving only the columns with data. As you all know, when unmerging
you get 1 column with the data (the 1st column) then the rest of the columns
of the merge remain blank, those I need to have removed - in an automatical
manner.
I did manage to find over the internet a macro which partially solves my
problem, but with a twist: instead of deleting the blank column it just
copies the data from the 1st cell to the rest (unerged cells). See the code
below. If anyone has any idea on how to modify this macro or a whole
different solution please assist / help me.

Sub TestUnmerge3()
Dim i As Long, n As Long
ReDim ay(1, 0)

With ActiveSheet.UsedRange
For i = 1 To .Count
If .Cells(i).MergeArea.Count 1 Then
If .Cells(i) < "" Then ' And .Cells(i).HasFormula = False '?
n = n + 1
ReDim Preserve ay(1, n)
ay(0, n) = .Cells(i).MergeArea.Address

ay(1, n) = .Cells(i).Value

End If
End If
Next
..UnMerge
End With
For i = 1 To n
Range(ay(0, i)).Value = ay(1, i)
Next
End Sub