Aszi1361
06-27-2017, 01:07 PM
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.
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.