MS Excel

Možná nějak takto, ale počkejte na řešení zkušenějších.

Private Sub CommandButton1_Click()

Sheets("Objednávky přeprav").Select
dd = Day(Now): mm = Month(Now): rr = Year(Now)

Columns("A:A").NumberFormat = "dd/mm/yy;@"
Columns("B:B").NumberFormat = "@"

pRadek = Application.WorksheetFunction.CountA(Range("a:a"))
Cells(pRadek + 1, "A") = Now

On Error Resume Next
If Month(Cells(pRadek, "A")) < mm Then
poradi = 1: GoTo px
End If

If pRadek = 1 Then
poradi = 1
Else
poradi = CDbl(Right(Cells(pRadek, "B"), 4)) + 1
End If
px:
On Error GoTo 0
poradiTXT = Format(Str(poradi), "0000")
rokTXT = Format(Str(rr), "0000")
mesTXT = Format(Str(mm), "00")
denTXT = Format(Str(dd), "00")
Cells(pRadek + 1, "B") = rokTXT & mesTXT & denTXT & poradiTXT
End Subcitovat

Lze i takto
Private Sub CommandButton1_Click()
Dim nrFaktury As Integer, radek As Long
radek = Cells(Rows.Count, 1).End(xlUp).Row + 1
With Cells(radek, 1)
If Month(.Offset(-1, 0).Value) = Month(Now) Then
If IsNumeric(Right(.Offset(-1, 1), 4)) Then
nrFaktury = 1
Else
nrFaktury = Right(.Offset(-1, 1), 4) + 1
End If
Else
nrFaktury = 1
End If
.Value = Format(Now, "dd/mm/yyyy")
.Offset(0, 1).Value = Format(Now, "yyyymmdd") & Format(nrFaktury, "0000")
End With 'cells(radek,1)
End Subcitovat