Sub Read_Data()
    Dim Sh As Worksheet, ShOUT As Worksheet
    Set Sh = ThisWorkbook.Worksheets("in")
    Set ShOUT = ThisWorkbook.Worksheets("out")
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    dx = Sh.Range("A2:AP" & LastRow)
    For n = 4 To 10
        dx(1, n) = dx(1, 3)
    Next
    dx(1, 2) = dx(1, 11)
    For n = 14 To 19
        dx(1, n) = dx(1, 13)
    Next
    For n = 21 To 26
        dx(1, n) = dx(1, 20)
    Next
    LastRow = 2
    For n = 4 To UBound(dx)
        Фонд = dx(n, 1)
        мероприятие = dx(n, 2)
        For i = 3 To 26
            Код = dx(2, i)
            Сумма = dx(n, i)
            If Val(Сумма) > 0 Then
                Категория = dx(3, i)
                Главнаякатегория = dx(1, i)
                ShOUT.Cells(LastRow, 2) = Фонд
                ShOUT.Cells(LastRow, 3) = мероприятие
                ShOUT.Cells(LastRow, 4) = Код
                ShOUT.Cells(LastRow, 5) = Сумма
                ShOUT.Cells(LastRow, 8) = Главнаякатегория
                ShOUT.Cells(LastRow, 9) = Категория
                LastRow = LastRow + 1
            End If
        Next
    Next
End Sub