Pessoal, bom dia!

Tenho um UserForm que inclui os dados direto em uma planilha.
Logo quando abro o formulário de cadastro, eu criei uma regra para ele já me dar o ID de lançamento (na imagem abaixo é o 6514).

Até aí tudo bem. O problema é que eu queria que a empresa toda utilizasse o formulário ao mesmo tempo.
Já cheguei a compartilhar a pasta de trabalho, porém, na hora de duas pessoas abrirem o formulário ao mesmo tempo, ele dá o mesmo número de ID para ambos (pois na coluna o último seria o 6513), e ele mantém os dados apenas da última pessoa que utilizou esse ID (ele sobrepõe o da primeira pessoa).

E se eu deixar para apenas uma pessoa abrir por vez fica um pouco inviável, somos em 80.

Qual seria a melhor forma de fazer com que desse certo?
Penso que quando a pessoa abrisse o formulário, a macro já colocaria o número direto na planilha. O problema seria se a pessoa saísse sem salvar, não posso ficar com a linha em branco porque dará problema nos relatórios que eu geraria depois.

Segue parte do código para quem puder me ajudar:

'Sub ao clicar no botão de cadastrar

Private Sub cmdCadastrar_Click()

Sheets("BD").Select

Dim linha As Integer
If Me.cboCodigo = "" Then
    MsgBox "Favor selecionar o código!", vbCritical, _
        "Cadastro inválido!"
    Me.cboCodigo.SetFocus
    Exit Sub
End If
If Me.txtDescricao = "" Then
    MsgBox "Preencha a descrição!", vbCritical, _
        "Cadastro inválido!"
    Me.txtDescricao.SetFocus
    Exit Sub
End If
If Me.txtData = "" Then
    MsgBox "Preencha a data!", vbCritical, _
        "Cadastro inválido!"
    Me.txtData.SetFocus
    Exit Sub
End If
If Me.cboColaborador = "" Then
    MsgBox "Selecione o colaborador correto!", vbCritical, _
        "Cadastro inválido!"
    Me.cboColaborador.SetFocus
    Exit Sub
End If
If Me.optSim = False And Me.optNao = False Then
        MsgBox "Por favor, informe se a cópia deverá ser cobrada", vbCritical, _
            "Cadastro inválido!"
        Exit Sub
End If
If Not IsNumeric(Me.txtQuantidade) = True Then
    MsgBox "Na quantidade informe um número válido!", _
        vbCritical, "Cadastro inválido!"
    Me.txtQuantidade.SetFocus
    Exit Sub
End If

linha = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(linha, 1) = Format(CInt(linha - 1), Number)
Cells(linha, 2) = Format(Me.cboCodigo, Number)
Cells(linha, 3) = Me.txtDescricao
Cells(linha, 4) = Format(Me.txtQuantidade, Number)
Cells(linha, 5) = Me.lblColab
Cells(linha, 6) = Me.txtData

If Me.optSim = True Then
    Cells(linha, 7) = "sim"
Else
    Cells(linha, 7) = "nao"
End If

Cells(linha, 8) = Format(Now(), "DD/MM/YY HH:MM")
Cells(linha, 9) = Me.cboColaborador
Cells(linha, 10) = UsuarioRede

Columns.AutoFit
MsgBox "Cópia(s) inclusa(s)!", vbInformation, _
            "LANÇADOR DE CÓPIAS ZANGARI V. 1.0"
'Me.txtDescricao = "" DESATIVADO PARA MANTER A ÚLTIMA DESCRIÇÃO
Me.txtQuantidade = ""
Me.cboCodigo = ""
Me.cboCodigo.SetFocus
Me.lblId = Me.lblId + 1

ActiveWorkbook.Save

End Sub

Private Sub cmdSair_Click()
Sheets("HOME").Select
    ActiveWorkbook.Save
    Unload Me
End Sub

Private Sub UserForm_INITIALIZE()

Sheets("BD").Select

    Dim linha As Integer, ultimoId As Integer
    linha = Cells(Rows.Count, 1).End(xlUp).Row
    If linha = 1 Then
        ultimoId = 0
    Else
        ultimoId = Cells(linha, 1)
    End If
    Me.lblId.Caption = ultimoId + 1

Me.txtData = Format(Now(), "DD/MM/YYYY")

lin = 2
Do Until Sheets("Condos").Cells(lin, 1) = ""
cboCodigo.AddItem Sheets("Condos").Cells(lin, 1)
lin = lin + 1
Loop

lin = 2
Do Until Sheets("Colaboradores").Cells(lin, 1) = ""
cboColaborador.AddItem Sheets("Colaboradores").Cells(lin, 1)
lin = lin + 1
Loop

'Me.cboCodigo.RowSource = "Condos!a2:a" & Cells(Rows.Count, 1).End(xlUp).Row

lblCondo = ""
lblColab = ""

'HideTitleBar = Esconder a barra de título
  HideTitleBar Me
    With Me
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With

End Sub

Obrigado!