[SRC vba]Private Sub Workbook_Open()

Dim prp As Variant
Dim prpV As Variant

For Each prp In ThisWorkbook.CustomDocumentProperties
    If prp.Name = "CurrentCounter" Then Exit Sub
Next

For Each prpV In ThisWorkbook.CustomDocumentProperties
    If prpV.Name = "CurrentCounter2" Then Exit Sub
Next

ThisWorkbook.CustomDocumentProperties.Add Name:="CurrentCounter", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=1
ThisWorkbook.CustomDocumentProperties.Add Name:="CurrentCounter2", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=1

End Sub


Sub SetNewCounter()  'установить новый счетчик
ThisWorkbook.CustomDocumentProperties("CurrentCounter").Value = Val(InputBox("Новое число?", "Определите новый номер Оплаты."))  ' "CurrentCo[CSV][color=black][/color][/CSV]unter"
ThisWorkbook.CustomDocumentProperties("CurrentCounter2").Value = Val(InputBox("Новое число?", "Определите новый номер Вознаграждения."))
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim num As Long
If Target.Column >= 1 And Target.Column <= 6 Then            'определяем диапазон непустых столбцов - 6 это "номер заказа"
    If Range(Cells(Target.Row, 30), Cells(Target.Row, 30)).Value = "" Then
        num = ThisWorkbook.CustomDocumentProperties("CurrentCounter").Value
        Range(Cells(Target.Row, 30), Cells(Target.Row, 30)).Value = num
        ThisWorkbook.CustomDocumentProperties("CurrentCounter").Value = num + 1
    End If
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim num2 As Long
If Target.Column >= 1 And Target.Column <= 5 Then            'определяем диапазон непустых столбцов - 5 это "номер заказа"
    If Range(Cells(Target.Row, 30), Cells(Target.Row, 30)).Value = "" Then
       num2 = ThisWorkbook.CustomDocumentProperties("CurrentCounter2").Value  'здесь выдает ошибку !!!
        Range(Cells(Target.Row, 30), Cells(Target.Row, 30)).Value = num2
        ThisWorkbook.CustomDocumentProperties("CurrentCounter2").Value = num2 + 1
    End If
End If

End Sub