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