Public Rng
Public Rng2
Sub Runme()

    Call chisla1
    Call chisla2
    Call otdel
    Call month
    Call clean

End Sub

Sub chisla2()

'Stavim chisla2

Set MyCollection = New Collection
Set MyCollection2 = New Collection

On Error Resume Next

For Each Cell In Rng.Cells
    MyCollection.Add Cell.Value, CStr(Cell.Value)
Next Cell

For Each Cell In Rng2.Cells
    MyCollection2.Add Cell.Value, CStr(Cell.Value)
Next Cell

For Each vNum In MyCollection
    lr = Sheets("N").Range("C" & Rows.Count).End(xlUp).Row
    Cells(lr + 1, 3) = vNum
    On Error GoTo 0
Next vNum

For Each vNum In MyCollection2
    lr = Sheets("N").Range("D" & Rows.Count).End(xlUp).Row
    Cells(lr + 1, 4) = vNum
    On Error GoTo 0
Next vNum

End Sub
Sub chisla1()

'Stavim chisla1

Columns(2).Insert
Cells(2, 2).Value = "Period"
i = 0

For k = 4 To Cells(1, Columns.Count).End(xlToLeft).Column

    Set Rng = Range(Cells(3, 5 + i), Cells(12, 5 + i))
    Set Rng2 = Range(Cells(3, 6 + i), Cells(12, 6 + i))
    
    i = i + 2
Call chisla2

Next k

End Sub
Sub otdel()

    'Stavim otdel

lr2 = Sheets("N").Range("C" & Rows.Count).End(xlUp).Row
lr = Sheets("N").Range("A" & Rows.Count).End(xlUp).Row + 1
j = 1

For i = lr + 1 To lr2 + 1

    lr = Sheets("N").Range("A" & Rows.Count).End(xlUp).Row + 1
    Cells(lr, 1) = Cells(2 + j, 1).Value
    j = j + 1

Next i

End Sub

Sub month()

Set Rng3 = Range(Cells(1, 2), Cells(1, 17))
Set MyCollection3 = New Collection

For Each Cell In Rng3.Cells
    If Not Cell.Value Like "" Then MyCollection3.Add Cell.Value, CStr(Cell.Value)
Next Cell

For Each vNum In MyCollection3

    lr = Sheets("N").Range("b" & Rows.Count).End(xlUp).Row + 1
    
    For i = lr To lr + 9
        Cells(i, 2).Value = vNum
    Next i
    On Error GoTo 0
Next vNum

End Sub

Sub clean()
    Range("E1:R12").ClearContents
    Rows(1).Delete
End Sub