Excel Select All Visible Merged cell then Spread Cell Data

[rtwiss via OfficeKB.com]

Can anyone help me with this. I have two parts of the program. Here they
are:
1) Sub findmerged()
Dim c
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
MsgBox c.Address & " is merged"
End If
Next
End Sub

2) Sub Unmerge()
Dim rng As Range, rngtot As Range, rngval As Variant
Dim strtrow As Long, endrow As Long, col As Long

strtrow = Selection.Row
col = Selection.Column
endrow = Application.WorksheetFunction.Min(Selection.End(xlDown).Row - 1,
Cells(65536, col).End(xlUp).Row + 1)
rngval = Selection.Value

Set rngtot = Range(Cells(strtrow, col), Cells(endrow, col))

ActiveCell.Unmerge
For Each rng In rngtot
rng.Value = rngval
Next rng

End Sub

 

[Bernie Deitrick]

rtwiss,

Try the macro below.

HTH,
Bernie
MS Excel MVP


Sub UnMergeAllCells()

Dim myC As Range
Dim myR As Range
Dim myV As Variant
Dim myM As Range

For Each myC In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If myC.MergeCells Then
Set myM = myC.MergeArea
myV = myC.Value
myC.UnMerge

For Each myR In myM
myR.Value = myV
Next myR
End If
Next myC
End Sub

 

[rtwiss via OfficeKB.com]

How wood i then make all cell universal shape, make a new sheet, and special
paste transposed on the new sheet?

rtwiss,

Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub UnMergeAllCells()

Dim myC As Range
Dim myR As Range
Dim myV As Variant
Dim myM As Range

For Each myC In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If myC.MergeCells Then
Set myM = myC.MergeArea
myV = myC.Value
myC.UnMerge

For Each myR In myM
myR.Value = myV
Next myR
End If
Next myC
End Sub

Can anyone help me with this. I have two parts of the program. Here they
are:

[quoted text clipped - 26 lines]

End Sub

 

[Bernie Deitrick]

rtwiss,

Dim myS As Worksheet

Cells.ColumnWidth = 11
Cells.RowHeight = 17
Set myS = ActiveSheet

Sheets.Add(Type:="Worksheet").Name = "New Sheet"
myS.Range("A1").CurrentRegion.Copy 'Or other code to pic up all the cells that you want to copy
Sheets("New Sheet").Range("A1").PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

HTH,
Bernie
MS Excel MVP

How wood i then make all cell universal shape, make a new sheet, and special
paste transposed on the new sheet?

rtwiss,

Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub UnMergeAllCells()

Dim myC As Range
Dim myR As Range
Dim myV As Variant
Dim myM As Range

For Each myC In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If myC.MergeCells Then
Set myM = myC.MergeArea
myV = myC.Value
myC.UnMerge

For Each myR In myM
myR.Value = myV
Next myR
End If
Next myC
End Sub

Can anyone help me with this. I have two parts of the program. Here they
are:

[quoted text clipped - 26 lines]

End Sub

 

[rtwiss via OfficeKB.com]

Bernie,

Some times this code unmerges cells but removes data that is supposed to be
spread. Also, i can not get excel to transpose the copy cells. It give me
an error stating that the cells are not the same shape and size. Any
suggestions? Thanks for the speady help!

rtwiss,

Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub UnMergeAllCells()

Dim myC As Range
Dim myR As Range
Dim myV As Variant
Dim myM As Range

For Each myC In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If myC.MergeCells Then
Set myM = myC.MergeArea
myV = myC.Value
myC.UnMerge

For Each myR In myM
myR.Value = myV
Next myR
End If
Next myC
End Sub

Can anyone help me with this. I have two parts of the program. Here they
are:

[quoted text clipped - 26 lines]

End Sub

 

[Bernie Deitrick]

Try changing

For Each myC In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)

to

For Each myC In ActiveSheet.UsedRange

The hidden cells might be getting copied....

HTH,
Bernie
MS Excel MVP

Bernie,

Some times this code unmerges cells but removes data that is supposed to be
spread. Also, i can not get excel to transpose the copy cells. It give me
an error stating that the cells are not the same shape and size. Any
suggestions? Thanks for the speady help!

rtwiss,

Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub UnMergeAllCells()

Dim myC As Range
Dim myR As Range
Dim myV As Variant
Dim myM As Range

For Each myC In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If myC.MergeCells Then
Set myM = myC.MergeArea
myV = myC.Value
myC.UnMerge

For Each myR In myM
myR.Value = myV
Next myR
End If
Next myC
End Sub

Can anyone help me with this. I have two parts of the program. Here they
are:

[quoted text clipped - 26 lines]

End Sub