Forum Discussion
besthannie25
Jun 05, 2024Copper Contributor
Merge cells containing the same information in multiple tables with macro
Hi everyone, I'm new to this and I'm trying to figure out how to do the following. I have an excel file, the first sheet is the main table and from this table different subtables are formed and each...
peiyezhu
Jun 06, 2024Bronze Contributor
Sub MergeSameCell(myRange)
'modify here
'Set myRange=("A5:F17")
MergeSame:
For Each Cell In myRange
If cell.Value = cell.Offset(1, 0).Value And Not IsEmpty(cell) Then
Range(cell, cell.Offset(1, 0)).Merge
cell.VerticalAlignment = xlCenter
GoTo MergeSame
End If
Next cell
End Sub
sub main()
' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Worksheets
set myRange=ws.cells(2,1).currentRange
MergeSame myRange
Next ws
end sub
Sub MergeSameCell(myRange As Range)
'modify here
'Set myRange=("A5:F17")
MergeSame:
For Each cell In myRange
If cell.Value = cell.Offset(1, 0).Value And Not IsEmpty(cell) Then
Range(cell, cell.Offset(1, 0)).Merge
cell.VerticalAlignment = xlCenter
GoTo MergeSame
End If
Next cell
End Sub
Sub main()
Dim ws As Worksheet
Dim myRange As Range
' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Worksheets
Set myRange = ws.Range("A5:F17") ' Define the range here
MergeSameCell myRange
Next ws
End Sub
- besthannie25Jun 06, 2024Copper ContributorHi, it works but is there any way to make the window that says: "merging cells only keeps the upper-left value and discards other values" ​​not appear? because you have to click on it several times to perform the action. And if i click on cancel button this message appear: Run time error '1004' Application-defined or object-defined error, and mark the following line in yellow
Range(cell, cell.Offset(1, 0)).Merge- HansVogelaarJun 07, 2024MVP
Insert the following line above the For ... Next loop:
Application.DisplayAlerts = False
and below it:
Application.DisplayAlerts = True