Sub Динамика2()
'
' Динамика Макрос
Dim i, K, NumSchet, Nm, Nk, Nf, status, f As Integer
Dim StartDate, j, sd As Date
Dim LastRow As Long
Dim NameKl As String
Dim ts
Sheets("Динамика").Cells.Clear
StartDate = #1/1/2017# ' дата начала анализа

'заполняем шапку таблицы ============================================
Range("A2").Value = "№1"
Range("B2").Value = "№2"
Range("C2").Value = "№3"
Range("D2").Value = "название"
Range("A2:D2").Borders.LineStyle = True
Range("A2:D2").Font.Bold = True
K = 4
For j = StartDate To DateAdd("m", 1, Date)
    Range("A1").Offset(1, K).Value = MonthName(DatePart("m", j)) & " " & DatePart("yyyy", j)
    Range("A1").Offset(1, K).Borders.LineStyle = True
    Range("A1").Offset(1, K).Font.Bold = True
    Range("A1").Offset(1, K).EntireColumn.AutoFit
    Range("A1").Offset(1, K).Interior.ColorIndex = 15
    j = DateAdd("m", 1, j)
    K = K + 1
Next j
'шапка заполнена =================================================================

NumSchet = Range(Worksheets("Ассортимент").Range("A101"), Worksheets("Ассортимент").Range("A101").End(xlDown)).Rows.Count
 For i = 101 To NumSchet 'указан диапазон счетов для анализа

'получаем данные из "Ассортимента" ===============================================        
    With Worksheets("Ассортимент")
        Set cell_address = .Cells.Find(what:="Статус заказа")
        status = cell_address.Column ' получаем номер столбца со статусом заказа
    End With
    If Worksheets("Ассортимент").Range("A1").Offset(i, status - 1) = 1 Then 'счет отгружен
        NameKl = Worksheets("Ассортимент").Range("A1").Offset(i, 3) 'название клиента/счета
        sd = Worksheets("Ассортимент").Range("A1").Offset(i, 4)
        If sd >= StartDate Then ' выполнено обязательное условие - дата счета больше стартовой даты
        Data_Scheta = MonthName(DatePart("m", Worksheets("Ассортимент").Range("A1").Offset(i, 4))) & " " & DatePart("yyyy", Worksheets("Ассортимент").Range("A1").Offset(i, 4)) 'получаем дату счета
        Nm = Worksheets("Ассортимент").Range("A1").Offset(i, 0) 'получаем номер менеджера
        Nk = Worksheets("Ассортимент").Range("A1").Offset(i, 1) 'получаем номер клиента
        Nf = Worksheets("Ассортимент").Range("A1").Offset(i, 2) 'получаем номер фирмы клиента
        If Len(NameKl) < 11 Then
            MsgBox "Слишком короткое название счета: " & Nm & " " & Nk & " " & Nf & " " & NameKl ' предупреждение о коротких названиях
            Else
                NameKl = Right(NameKl, Len(NameKl) - 11)
        End If
        SummScheta = Worksheets("Ассортимент").Range("A1").Offset(i, 5) 'получаем сумму счета
  
'начинаем заполнять таблицу =======================================================
            LastRow = Cells(Rows.Count, 1).End(xlUp).Row
          ' разносятся счета по уже занесенным клиентам
            For f = 2 To LastRow
                   If Range("A1").Offset(f, 0).Value = Nm And Range("B1").Offset(f, 0).Value = Nk And Range("C1").Offset(f, 0).Value = Nf Then
                        K = 4
                        For j = StartDate To DateAdd("m", 1, Date)
                            If Data_Scheta = Range("A1").Offset(1, K) Then
                                Range("A1").Offset(f, K).Value = Range("A1").Offset(f, K).Value + SummScheta
                                Range("A1").Offset(f, K).NumberFormat = "#,##0"
                                Range("A1").Offset(f, K).Borders.LineStyle = True
                            End If
                            j = DateAdd("m", 1, j)
                            K = K + 1
                        Next j
                        GoTo NextSchet
                   End If
            Next f
        ' разносятся счета по новым клиентам
          Range("A1").Offset(LastRow, 0).Value = Nm
          Range("A1").Offset(LastRow, 0).Borders.LineStyle = True
          Range("B1").Offset(LastRow, 0).Value = Nk
          Range("B1").Offset(LastRow, 0).Borders.LineStyle = True
          Range("B1").Offset(LastRow, 0).NumberFormat = "###" 
          Range("C1").Offset(LastRow, 0).Value = Nf
          Range("C1").Offset(LastRow, 0).Borders.LineStyle = True
          Range("D1").Offset(LastRow, 0).Value = NameKl
          Range("D1").Offset(LastRow, 0).Borders.LineStyle = True
          Range("A1").Offset(LastRow, 0).Rows.AutoFit
          K = 4
          For j = StartDate To Date Step 0
              If Data_Scheta = Range("A1").Offset(1, K) Then
                Range("A1").Offset(LastRow, K).Value = Range("A1").Offset(LastRow, K).Value + SummScheta
                Range("A1").Offset(LastRow, K).NumberFormat = "#,##0"
                Range("A1").Offset(LastRow, K).Borders.LineStyle = True
                Else
                  Range("A1").Offset(LastRow, K).Borders.LineStyle = True
              End If
              j = DateAdd("m", 1, j)
              K = K + 1
          Next j
          f = 0
            Else
         '   MsgBox "счет " & NameKl & " не входит в выбранный диапазон"
        End If
    End If
NextSchet:
 Next i
ActiveSheet.Range("A2", Range("A2").Offset(LastRow - 2, K - 1)).Sort [B:B], xlAscending, , , , , , xlYes
End Sub