Anexo

Veja se é isso o que deseja...

Sub inserir_codigo()
Dim ul, x As Long
ul = Plan1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ul
Plan1.Range("A" & i).Select
x = Application.WorksheetFunction.VLookup(ActiveCell.Row, Range("A:A"), 1, 0)
On Error GoTo erro
If ActiveCell.Row <> x Then
Plan1.Range("A" & ul + 1).Value = x
End If
Next i
Exit Sub
erro:
Plan1.Range("A" & ul + 1).Value = ActiveCell.Row
End Sub

Abrç!

Bom dia,

Funciona no arquivo enviado.
Quando jogo no meu formulário gera erro.
Estou trabalhando para resolver.

Paz e bem.

Klarc28,

Tubo bem,

Tentei adaptar o seu código no meu formulário, mas está dando um erro na linha:
While Plan1.Range("A" & linha).Value <> "" And achou = False

Não estou conseguindo enviar o arquivo, está acusando acima de 50KB e, mesmo compactando.
Poderia me ajudar, o ideal que vc visse a planilha, pode me ajudar.

Paz e Bem.

While sheets("NomeDaSuaPlanilha").Range("A" & linha).Value <> "" And achou = False

Substitua NomeDaSuaPlanilha pelo nome da sua planilha.

ou

While sheets(1).Range("A" & linha).Value <> "" And achou = False

Substitua o número 1 pelo número da sua planilha.

ou

While Planilha1.Range("A" & linha).Value <> "" And achou = False

Substitua o número 1 pelo número da sua planilha.

Enfim, vá modificando e testando, de acordo com o nome ou número da planilha desejada.

Bom dia.
klarc28,

Esse erro foi corrigido, obrigado.

Porém está gravando assim:

1 A B
2 CÓD NOME
3 1 ALAN
4 1
5 3 ROSE
6 4 MARCO
7 DERAM

Gravação correta:

1 A B
2 CÓD NOME
3 1 ALAN
4 2 DERAM (essa linha seria incluída)
5 3 ROSE
6 4 MARCO

Segue código que estou usando:

Private Sub Botão_Novo_Click()
Dim cod As Long
Dim linha As Long
linha = 1
Dim achou As Boolean
achou = False
While Sheets("CADASTRO").Range("A" & linha).Value <> "" And achou = False

If Sheet2.Range("A" & linha).Value <> linha Then

cod = linha
achou = True
End If
linha = linha + 1

Wend

linha = 1
While Sheet2.Range("A" & linha).Value <> ""

linha = linha + 1

Wend
If achou = True Then
Sheet2.Range("A" & linha).Value = cod
Else
Sheet2.Range("A" & linha).Value = Sheet2.Range("A" & linha - 1).Value + 1

End If

Range("A1:B5").Select
ActiveWorkbook.Worksheets("CADASTRO").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("CADASTRO").Sort.SortFields.Add Key:=Range("A2:A5") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("CADASTRO").Sort
.SetRange Range("A1:B5")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Botão_Novo.Enabled = True

caixa_nome.SetFocus

End Sub

Private Sub Botão_Gravar_Click()

Dim lin As Integer
lin = 2
Do Until Sheet2.Range("A" & lin).Value = ""
If Sheet2.Range("A" & lin).Text = caixa_Cód.Value Then
Exit Do
End If
lin = lin + 1
Loop

Sheet2.Range("A" & lin).Value = caixa_Cód.Value
Sheet2.Range("B" & lin).Value = caixa_nome.Value

caixa_Cód = ""
caixa_nome = ""

caixa_Cód.SetFocus

End Sub

Paz e bem.
Isidro