Excel Select All Visible Merged cell then Spread Cell Data
 

Can anyone help me with this. I have two parts of the program. Here they
a
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(xl Down).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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200810/1

Excel Select All Visible Merged cell then Spread Cell Data
 

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(xlCellTypeVisib le)
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" <u46610@uwe wrote in message
news:8b48799c482ea@uwe...
Can anyone help me with this. I have two parts of the program. Here they
a
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(xl Down).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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200810/1

Excel Select All Visible Merged cell then Spread Cell Data
 

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

Bernie Deitrick wrote:
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(xlCellTypeVisib le)
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
a
[quoted text clipped - 26 lines]

End Sub

--
Message posted via http://www.officekb.com

Excel Select All Visible Merged cell then Spread Cell Data
 

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


"rtwiss via OfficeKB.com" <u46610@uwe wrote in message news:8b4fb7b2b5ce0@uwe...
How wood i then make all cell universal shape, make a new sheet, and special
paste transposed on the new sheet?

Bernie Deitrick wrote:
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(xlCellTypeVisib le)
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
a
[quoted text clipped - 26 lines]

End Sub

--
Message posted via http://www.officekb.com

Excel Select All Visible Merged cell then Spread Cell Data
 

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!

Bernie Deitrick wrote:
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(xlCellTypeVisib le)
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
a
[quoted text clipped - 26 lines]

End Sub

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200810/1

Excel Select All Visible Merged cell then Spread Cell Data
 

Try changing

For Each myC In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisib le)

to

For Each myC In ActiveSheet.UsedRange

The hidden cells might be getting copied....

HTH,
Bernie
MS Excel MVP


"rtwiss via OfficeKB.com" <u46610@uwe wrote in message news:8b50659f0410b@uwe...
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!

Bernie Deitrick wrote:
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(xlCellTypeVisib le)
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
a
[quoted text clipped - 26 lines]

End Sub

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200810/1