Multiple Command Buttons on one Excel sheet

Question

I have the project in excel with transferring data. It is necessary to allow the run of each individually.

Sheet1 is basic with empty table. Sheet2 is the list of 20+ Command Buttons. And have 20+ sheets with data which is transferring to Sheet1 in table, by clicking on 20+ Command Buttons (from Sheet2). Therefore, each command button refers to a separate sheet of those 20+.

https://i.stack.imgur.com/NdXyz.jpg

This is the Command Button which runs command Insert Rows. All rows go to basic table (Sheet1) recognising the number from first column.

Private Sub CommandButton1_Click()
Dim lastrowOS, lastrowPrekovremeno As Long
Dim skip As Boolean
Dim list As New Collection

lastrowOS = Sheets("OS").Cells(Rows.Count, 1).End(xlUp).Row
lastrowPrekovremeno = Sheets("Prekovremeno").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("OS").Cells(1, 13).Value = lastrowPrekovremeno

For i = lastrowOS To 3 Step -1
    skip = False
    For k = 1 To list.Count
        If list(k) = Sheets("OS").Cells(i, 1).Value Then
            skip = True
        End If
    Next k
    If Not skip Then
        For j = lastrowPrekovremeno To 3 Step -1
            If Sheets("Prekovremeno").Cells(j, 1).Value = Sheets("OS").Cells(i, 1).Value Then
                list.Add (Sheets("OS").Cells(i, 1).Value)
                Sheets("Prekovremeno").Cells(j, 1).EntireRow.Copy
                Sheets("OS").Cells(i + 1, 1).Insert Shift:=xlDown
            End If
        Next j
    End If
Next i

End Sub

Now next two.

I also made UnDo Chommand Button (Sheet1), in case of a tax click on an unnecessary Chommand Button. And that code doesn't work.

Private mcolUndoObjects As Collection
Private mUndoObject As clsUndoObject

Public Function AddAndProcessObject(oObj As Object, sProperty As String, vValue As Variant) As Boolean
    Set mUndoObject = New clsUndoObject
    With mUndoObject
        Set .ObjectToChange = oObj
        .NewValue = vValue
        .PropertyToChange = sProperty
        mcolUndoObjects.Add mUndoObject
        If .ExecuteCommand = True Then
            AddAndProcessObject = True
        Else
            AddAndProcessObject = False
        End If
    End With
End Function

Private Sub Class_Initialize()
    Set mcolUndoObjects = New Collection
End Sub

Private Sub Class_Terminate()
    ResetUndo
End Sub

Public Sub ResetUndo()
    While mcolUndoObjects.Count > 0
        mcolUndoObjects.Remove (1)
    Wend
    Set mUndoObject = Nothing
End Sub

Public Sub UndoAll()
    Dim lCount As Long
    '    On Error Resume Next
    For lCount = mcolUndoObjects.Count To 1 Step -1
        Set mUndoObject = mcolUndoObjects(lCount)
        mUndoObject.UndoChange
        Set mUndoObject = Nothing
    Next
    ResetUndo
End Sub

Public Sub UndoLast()
    Dim lCount As Long
    '    On Error Resume Next
    If mcolUndoObjects.Count >= 1 Then
        Set mUndoObject = mcolUndoObjects(mcolUndoObjects.Count)
        mUndoObject.UndoChange
        mcolUndoObjects.Remove mcolUndoObjects.Count
        Set mUndoObject = Nothing
    Else
        ResetUndo
    End If
End Sub

Public Function UndoCount() As Long
    UndoCount = mcolUndoObjects.Count
End Function

Private Sub CommandButton2_Click()

End Sub

After inserting the appropriate sheets by clicking on the selected Command Buttons, it is necessary to combine the numbers in the first column. This code works but confirmation is required in the info message to OK for each number being merged. Is it possible all merge cells with one clikc on Command Button?

Private Sub CommandButton1_Click()
Dim lastrowOS As Long
Dim minIndex, maxIndex As Integer
Dim skip As Boolean
Dim list As New Collection

lastrowOS = Cells(Rows.Count, 1).End(xlUp).Row


For i = 3 To lastrowOS
    minIndex = 9999999
    maxIndex = -1
    skip = False
    For k = 1 To list.Count
        If list(k) = Cells(i, 1).Value Then
            skip = True
        End If
    Next k
    If Not skip Then
        For j = 3 To lastrowOS
            If Cells(i, 1).Value = Cells(j, 1).Value Then
                list.Add (Cells(i, 1).Value)
                If j < minIndex Then
                    minIndex = j
                End If
                If j > maxIndex Then
                    maxIndex = j
                End If
            End If
        Next j
        If Not maxIndex = -1 Then
             Range(Cells(maxIndex, 1), Cells(minIndex, 1)).Merge
        End If
    End If
Next i
    
End Sub
    
Option Explicit

Answer 1

Use DisplayAlerts = False to suppress the messages.

Option Explicit
Sub demomerge()

    Dim i As Long, n As Long, lastrowOS As Long
    
    lastrowOS = Cells(Rows.Count, 1).End(xlUp).Row
    n = 0
    Application.DisplayAlerts = False
    For i = 3 To lastrowOS
        n = n + 1
        ' look head
        If Cells(i + 1, 1).Value2 <> Cells(i, 1).Value2 Then
            If n > 1 Then
                Cells(i - n + 1, 1).Resize(n).merge
            End If
            n = 0
        End If
    Next
    Application.DisplayAlerts = True
   
End Sub