To unmerge cells and fill down blank cells with data from above

[Aszi1361]

Hello,
I have found a VBA code on the internet for unmerging the cells and then filling down the blank cells with the cell on above but the problem which i have with this VBA code is that i have to run it for every sheet in the excel file.I mean if i have 7 sheets i have to run it 7 times.is there anybody here to help me to generalize the VBA code for whole of worksheets into workbook by running the macro only once and it's done for all the sheet entirely.



Public Sub ProcessData()
Dim cell As Range
Dim MergedCell As Range
Dim NumRows As Long
Dim NumCols As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

For Each cell In Range("A1").Resize( _
.Cells.SpecialCells(xlCellTypeLastCell).Row, _
.Cells.SpecialCells(xlCellTypeLastCell).Column)

If cell.MergeCells Then

NumRows = cell.MergeArea.Rows.Count
NumCols = cell.MergeArea.Columns.Count
cell.UnMerge
If NumRows > 1 Then cell.AutoFill cell.Resize(NumRows)
If NumCols > 1 Then cell.Resize(NumRows).AutoFill cell.Resize(NumRows, NumCols)
End If
Next cell
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

Many thanks if somebody could help me.

[mdmackillop]

Public Sub ProcessData()
Dim cell As Range
Dim MergedCell As Range
Dim NumRows As Long
Dim NumCols As Long
Dim Sh As Worksheet

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each Sh In Worksheets
With Sh
For Each cell In Sh.UsedRange.Cells
If cell.MergeCells Then
NumRows = cell.MergeArea.Rows.Count
NumCols = cell.MergeArea.Columns.Count
cell.UnMerge
If NumRows > 1 Then cell.AutoFill cell.Resize(NumRows)
If NumCols > 1 Then cell.Resize(NumRows).AutoFill cell.Resize(NumRows, NumCols)
End If
Next cell
End With
Next Sh
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

[Aszi1361]

Thanks a lot for your quick answer. It's working without any problem

[Nick G]

Wow that works great but I am having a minor problem. The problem is that my data has addresses which have pin code at the end and floor no in the beginning, so when it unmerge and autofills it down it increases the numbers like. The 1st floor becomes 2nd floor,3rd floor and like that at the beginning and the pin code increases from 400028 to 400029 etc.

The data is large so I can not do it manually. The below code is otherwise working perfectly the only thing I want is that I don't want the autofill to be incremental.

So is there any way I can make modification to the above code to just fill down anything without increasing the values in autofill. Please help.

[Nick G]

Hey it's fine.I found the solution. Thanks to the forum

If NumRows > 1 Then cell.AutoFill Destination:=cell.Resize(NumRows), Type:=xlFillCopy
If NumCols > 1 Then cell.Resize(NumRows).AutoFill Destination:=cell.Resize(NumRows, NumCols), Type:=xlFillCopy

[Nick G]

Hey it's fine.I found the solution. Thanks to the forum


If NumRows > 1 Then cell.AutoFill Destination:=cell.Resize(NumRows), Type:=xlFillCopy
If NumCols > 1 Then cell.Resize(NumRows).AutoFill Destination:=cell.Resize(NumRows, NumCols), Type:=xlFillCopy