iRow = Sheets("Data1").UsedRange.Row + Sheets("Data1").UsedRange.Rows.Count -  1 
For i = j -  1  To  1  Step - 1 
    T1_date = Sheets("Data_F").Cells( 1 , i)
'    Находим требуемую дату на листе "Data1"
    L = "Data1"
    CLM_1 = FindColumn(L, CStr(T1_date))
        
        If CLM_1 <>  0  Then
                Set ws = ActiveWorkbook.Worksheets(L)
                A1 = " "
                A2 =  2 
                While A1 <> ""
'                   диапазон поиска в столбце
                    Set FC1 = ws.Range(Sheets(L).Cells(A2, CLM_1), Sheets(L).Cells(iRow, CLM_1))
'                    Нашли
                    A1 = FC1.End(xlDown).Value
'                        Если то, что нашли - пустое, тогда это конец
                        If A1 = "" Then GoTo metka_K2:
'                    а в какой строке нашли?
                    A2 = FC1.End(xlDown).Row

'                   диапазон поиска в строке
                    Set FR1 = ws.Range(Sheets(L).Cells(A2,  4 ), Sheets(L).Cells(A2, CLM_1 -  2 ))
metka_K1:
'                    Нашли
                    B1 = FR1.End(xlToRight).Value
'                        если встретился 0 - это ошибка - исправить
                        If B1 = "0" Then
                            FR1.End(xlToLeft).Value = ""
                            GoTo metka_K1:
                        End If
'                        Если то, что нашли - пустое,
'                        или колонка найденного не поменялась, тогда значит нашли 0
                        If B1 = "" Or FR1.End(xlToRight).Column = CLM_1 Then
                            B1 = "0"
                        End If
'                    читаем данные
                    B2 = CInt(Sheets("Data_F").Cells( 2 , i))
'                    вычисляем новые
                    B3 = B2 + CInt(A1) - CInt(B1)
'                    записываем новые
                    Sheets("Data_F").Cells( 2 , i) = CStr(B3)
                Wend
                    
        Else
'        Если даты нет - тогда запоминаем 0
            Sheets("Data_F").Cells( 2 , i) =  0 
        End If
metka_K2:

' ...................
' здесь такая - же обработка других листов с похожей структурой
' ...................

next i

Function ColumnAnaliz_1(ByRef SheetsName As String, ByRef ColumnNumber As Long, _
                        ByRef StartDataRow As Integer, ByRef BlokColumnNumber As Integer) As Integer
                        
Dim A1 As String
Dim A2 As Integer

Dim B1 As String

Dim C1 As Integer

Dim iRow As Long

Dim i As Long

rem Определяем конец листа
iRow = Sheets(SheetsName).UsedRange.Row + Sheets(SheetsName).UsedRange.Rows.Count -  1 
rem стартовая строка
i = StartDataRow
rem накопленная сумма
C1 =  0 
Do
    rem смотрим на ячейку
    A1 = Sheets(SheetsName).Cells(i, ColumnNumber)
    rem если не пустая
    If A1 <> "" Then
        rem включаем строчный анализ
        B1 = RowAnaliz_1(SheetsName, i, ColumnNumber, BlokColumnNumber)
        rem и перескакиваем на следующую строку
        i = i +  1 
    Else
        rem Если пустая ищем первую полную
        A1 = Sheets(SheetsName).Cells(i, ColumnNumber).End(xlDown).Value
         rem если не нашли - конец листа достигнут
          If A1 = "" Then Exit Do
        rem запоминаем номер строки, где нашли
        A2 = Sheets(SheetsName).Cells(i, ColumnNumber).End(xlDown).Row
        rem включаем строчный анализ
        B1 = RowAnaliz_1(SheetsName, CLng(A2), ColumnNumber, BlokColumnNumber)
        rem и перескакиваем на следующую строку
        i = A2 +  1 
    End If
rem Производим накопление суммы
    C1 = C1 + CInt(A1) - CInt(B1)
Loop Until A1 = ""
     Rem выдаем результат
    ColumnAnaliz_1 = C1

End Function

Function RowAnaliz_1(ByRef SheetName As String, ByRef NumberRow As Long, _
                    ByRef StartDataColumn As Long, _
                    ByRef ColumnBlockNumber As Integer) As Integer
    
Dim B1 As String
Dim B2 As Integer
rem значение левого данного
B1 = ""
Do
    rem смотрим на ячейку левее
    B1 = Sheets(SheetName).Cells(NumberRow, StartDataColumn -  1 )
      rem Если пустая ищем первую полную
    If B1 = "" Then
        rem Значение левой ячейки
        B1 = Sheets(SheetName).Cells(NumberRow, StartDataColumn).End(xlToLeft).Value
        rem колонка найденной ячейки
        B2 = Sheets(SheetName).Cells(NumberRow, StartDataColumn).End(xlToLeft).Column
rem        если ничего не найдено или колонка найденной ячейки принадлежит 
rem        диапзону от 1 до ColumnBlockNumber то данные равны 0
        If B1 = "" Or B2 < ColumnBlockNumber Then
            B1 =  0 
        End If
    End If
Loop Until B1 <> ""
rem присваиваем результат
RowAnaliz_1 = B1

End Function