Tady je upravena procedura:

Option Explicit

Sub Scitat()
' deklarace promennych
  Dim Blok As Range, Soucet As Range, SumPrijmy As Single, SumVydani As Single
  Dim c As Range, i As Integer, ofs As Integer
  ' definice prohledavaneho bloku
  Set Blok = Worksheets("list1").Range("b7:b1000")
  ' definice bunky pro ulozeni vysledku souctu za sloupec b7:b1000
  Set Soucet = Blok.Offset(-4, 0).Resize(1, 1)
  ' ofset pro dalsi sloupce (E7:E1000, H7:H1000,...)
  ofs = 3
  ' vykonna smycka projde vsechny sloupce
  For i = 0 To 51  ' pocet sloupcu
    ' vynulovani promennych pro ulozeni mezisouctu
    SumPrijmy = 0
    SumVydani = 0
    For Each c In Blok.Offset(0, ofs * i).Cells
      ' testovani bunky ve sloupci prijmu b7:b1000 (e7:e1000, h7:h1000,...)
      If IsNumeric(c.Value) And _
      c.Font.Color = 0 Then SumPrijmy = SumPrijmy + c.Value  ' je cislo a cerna, pricist
      ' testovani bunky ve sloupci vydani c7:c1000 (f7:f1000, i7:i1000,...), ma offset(0,1) oproti sloupci b(..)
          If IsNumeric(c.Offset(0, 1).Value) And _
      c.Offset(0, 1).Font.Color = 0 Then SumVydani = SumVydani + c.Offset(0, 1).Value  ' je cislo a cerna, pricist
        Next c
        ' vlozeni hlavicky do a2 (d2,g2,...)
        Soucet.Offset(-1, (ofs * i) - 1).Value = "Týždeò: " & i + 1
        ' vlozeni hlavicky do a3 (d3,g3,...) pro prijmy
        Soucet.Offset(0, (ofs * i) - 1).Value = "Príjmy:"
        ' vlozeni souctu do bunky b3 (e3, h3,...) pro prijmy
        Soucet.Offset(0, ofs * i).Value = SumPrijmy
        ' vlozeni hlavicky do a4 (d4,g4,...) pro vydani
        Soucet.Offset(1, (ofs * i) - 1).Value = "Vydavky:"
        ' vlozeni souctu do bunky b4 (e4, h4,...) pro vydani
        Soucet.Offset(1, ofs * i).Value = SumVydani
      Next i
    End Sub