Sub unmergeAndFix()
Dim wkb As Workbook
Dim sht As Worksheet
Dim r As Range, rInArea As Range, vMgValue As Variant
Dim mAreaCount As Long
Set wkb = ActiveWorkbook
Set sht = wkb.ActiveSheet
For Each r In sht.Range("A2", sht.Range("A" & sht.Rows.Count).End(xlUp))
If r.MergeArea.Count > 1 Then 'propogate data, then unmerge
'first get the value on the merged area
For Each rInArea In r.MergeArea
If rInArea.Value <> "" Then
vMgValue = rInArea.Value
Exit For
End If
Next rInArea
Set rInArea = r.MergeArea 'hold this address
'now, breakup the merge
r.MergeArea.UnMerge
'now, set each element in the merged area to that value
rInArea.Value = vMgValue
End If
Next r
End Sub
Sub UnMergeThem()
Dim LastR As Long, LastC
Dim arr As Variant
Dim Counter As Long
Dim TheValue As Variant
Dim TestValue As Variant
With ActiveSheet
LastR = .Cells(.Rows.Count, "b").End(xlUp).Row
LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range("a1:a" & LastR).UnMerge
arr = .Range("a1", .Cells(LastR, LastC)).Value
For Counter = 1 To LastR
TestValue = arr(Counter, 1)
If TestValue <> "" Then
TheValue = TestValue
Else
arr(Counter, 1) = TheValue
End If
Next
.Range("a1", .Cells(LastR, LastC)).Value = arr
End With
MsgBox "Done"
End Sub
Title | # Comments | Views | Activity |
---|---|---|---|
Excel 2013 Problem | 12 | 44 | |
IF Statement | 3 | 23 | |
How can I sort the data shown in Sheet 1 and copy it to Sheet 2? | 8 | 21 | |
In Excel 2007, how do I need to correct this ampersand formula so it works? | 2 | 13 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
10 Experts available now in Live!