Option Explicit

Sub Dobavit()
Dim i&, k&, n&
Dim L As Worksheet
With Лист1
    k = .UsedRange.Row + .UsedRange.Rows.Count - 1
    For i = 2 To k
        If .Cells(i, 33) = "a" Then
            If .Cells(i, 32) > .Cells(i, 31) Then
                MsgBox "Указанное количество превышает остаток" & vbNewLine & _
                    "Ошибка в строке №" & i, vbExclamation, "Разуй глаза"
                    .Rows(i).Select
                Exit Sub
            End If
            If .Cells(i, 32) = 0 Then
                MsgBox "Указали в количестве 0" & vbNewLine & _
                    "Ошибка в строке №" & i, vbExclamation, "Разуй глаза"
                    .Rows(i).Select
                Exit Sub
            End If
            If .Cells(i, 32) < 0 Then
                MsgBox "Вы указали в количестве отрицательное значение" & vbNewLine & _
                    "Ошибка в строке №" & i, vbExclamation, "Разуй глаза"
                    .Rows(i).Select
                Exit Sub
            End If
        End If
    Next i
    Set L = Лист2
    For i = 2 To k
        If .Cells(i, 33) = "a" Then
            n = L.UsedRange.Row + L.UsedRange.Rows.Count
            L.Range(L.Cells(n, 1), L.Cells(n, 30)) = .Range(.Cells(i, 1), .Cells(i, 30)).Value
            L.Cells(n, 31) = .Cells(i, 32)
            L.Range(L.Cells(n, 1), L.Cells(n, 31)).Borders.LineStyle = xlContinuous
            .Cells(i, 31) = .Cells(i, 31) - .Cells(i, 32)
            .Range(.Cells(i, 32), .Cells(i, 33)) = ""
        End If
    Next i
    Set L = Nothing
End With
MsgBox "Данные перенесены.", vbInformation, "Океюшки"
End Sub

Option Explicit

Sub VseVmeste()
Dim Sh As Worksheet
Dim s&, n&, k&
Application.ReferenceStyle = xlA1
Application.ScreenUpdating = False
n = 11: k = 0
List.Rows("11:" & List.Cells(List.Rows.Count, 2).End(xlUp).Row + 2).Delete
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name <> "Общий" Then
        For s = 11 To Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row
            If Sh.Cells(s, 2) = "" Then Exit For
        Next
        If s <> 11 Then
            If k = 0 Then k = s - 1 Else: k = k + s - 11
            List.Range("B" & n & ":BH" & k) = Sh.Range("B11:BH" & s - 1).Value
            n = k + 1
        End If
    End If
Next
n = 0
For s = 11 To k
    n = n + 1
    List.Cells(s, 1) = n
Next
List.Range("A11:BH" & k).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
MsgBox "Объединение выполнено", vbInformation, "Выполнено"
End Sub