Sub Oper()
Dim i&, j&, k&
Dim t$(), s$, Name1$
Dim i_n&, j_n&
Name1 = "Тест"
i_n = Cells(Rows.Count, 1).End(xlUp).Row
j_n = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim t(i_n, j_n)
For i = 1 To i_n
For j = 1 To j_n
    If Cells(i, j) <> "" And i <> 1 And j <> 1 And i < 33 Then
        Cells(i, j) = -1 * (Cells(i, j) - 38.5)
    End If
    t(i, j) = Cells(i, j)
Next j
Next i
MsgBox Now()
Open ActiveWorkbook.Path & "\" & Replace(Now(), ":", "-") & ".txt" For Output As 1
For i = 2 To i_n
s = ""
For j = 2 To j_n
    If t(i, j) <> "" Then
        k = k + 1
        s = k & " " & t(1, j) & " " & t(i, 1) & " " & t(i, j) & " " & Name1 & Chr(13)
        Print #1, s
    End If
Next j
Next i
Close 1
End Sub

s = k & " " & t(1, j) & " " & t(i, 1) & " " & t(i, j) & " " & Name1 & Chr(13)

s = k & " " & t(1, j) & " " & t(i, 1) & " " & Replace(0.01 * t(i, j), ",", ".") & " " & Name1 & Chr(13)