Option Explicit

Public Sub test()
    Dim Rng1 As Range
    Dim rng2 As Range
    Dim i As Integer, j%, k%, lastRow%
    
    Set Rng1 = Worksheets("Об-е").UsedRange
    Set rng2 = Worksheets("Статистика").UsedRange
    Worksheets("Статистика").Range("A2:D100").ClearContents
    
    lastRow = Worksheets("Об-е").Cells(Rows.Count, 1).End(xlUp).Row
    k = 2

    While Rng1.Cells(1, 3 + i).Value <> ""
    j = 2
    While j <= lastRow
    If Val(Rng1.Cells(j, 3 + i).Value) + Val(Rng1.Cells(j, 3 + i+1).Value) > 0 Then
        rng2.Cells(k, 1).Value = Rng1.Cells(1, 3 + i).Value
        rng2.Cells(k, 2).Value = Rng1.Cells(j, 1).Value
        rng2.Cells(k, 3).Value = Val(Rng1.Cells(j, 3 + i).Value) + Val(Rng1.Cells(j, 3 + i + 1).Value)
        
        k = k + 1
    End If
    j = j + 1
    Wend
    i = i + 2
    Wend
End Sub

Sub Макрос1()

Dim strLastRow As Long, gLastRow As Long
Dim stlstCol As Integer, L As Date
With Sheets("сводка")
  strLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  gLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
  stlLastCol = Cells(1, Columns.Count).End(xlToRight).Column
  g = gLastRow
  If g > 2 Then L = .Cells(g, 1)
  End If
    For a = 3 To stlLastCol
    For i = 2 To strLastRow
If Cells(i, a) = "рем" Then
If L < Cells(1, a) Then
g = g + 1
.Cells(g, 1).Value = Cells(1, a).Value
.Cells(g, 2).Value = Cells(i, 1).Value
  .Cells(g, 3).Value = Cells(i, 2).Value
   .Cells(g, 4).Value = Cells(i, a).Value
   Else: End If
  End If
  Next
  Next
  End With
  Sheets("сводка").Select
  End Sub

With Sheets("сводка")
...
Sheets("сводка").Select

Sub Макрос1()
    Dim strLastRow As Long, gLastRow As Long
    Dim stlstCol As Integer, L As Date
    Dim sh1 As Worksheet
    Set sh1 = ThisWorkbook.Sheets("Об-е")
    With Sheets("сводка")
        strLastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
        gLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        stlLastCol = sh1.Cells(1, Columns.Count).End(xlToRight).Column
        g = gLastRow
        If g > 2 Then L = .Cells(g, 1)
        For a = 3 To stlLastCol
            For i = 2 To strLastRow
                If sh1.Cells(i, a) = "рем" Then
                    If L < sh1.Cells(1, a) Then
                        g = g + 1
                        .Cells(g, 1).Value = sh1.Cells(1, a).Value
                        .Cells(g, 2).Value = sh1.Cells(i, 1).Value
                        .Cells(g, 3).Value = sh1.Cells(i, 2).Value
                    Else: End If
                End If
            Next
        Next
    End With
    Sheets("сводка").Select
End Sub