srobles boa tarde,
Muito obrigado por sua ajuda!
Era isso mesmo que precisava!!
Nossa! não imaginava que dava para fazer todo o processo com apenas uma rotina.
Só uma dúvida referente a planilha que vai ser copiado os números.
Para redirecionar o destino, devo incluir todo o endereço do diretório?
EX: "C:UsuariosfabiospDocumentosNumeros_de_reg_utilizados.xlsx
Mais uma vez obrigado!
Abraços.
Fabiosp
 Dim vRegistro As String
Dim planRegistros, planValidação As String
Sub validaRegistro()
    'Variavel para contar as linhas utilizadas
    Dim ultimaLinha As Integer
    'Desabilita atualização de tela
    Application.ScreenUpdating = False
    'Variavel com o nome da planilha principal
    planRegistros = ThisWorkbook.Name
    'Variavel com o valor da célula a ser pesquisada
    vRegistro = ThisWorkbook.Sheets("Registros").Range("B1")
    'Abre a outra planilha
    Workbooks.Open ThisWorkbook.Path & "Numeros_de_reg_utilizados.xlsx"
    'Variavel com o nome da planilha de destino
    planValidação = "Numeros_de_reg_utilizados.xlsx"
    
    'Com a pasta de destino, ativa a planilha com os registros usados
    With Windows(planValidação)
        .Activate
        'Com a planilha que contem os registros
        With Sheets("Num_Reg")
            .Activate
            Range("A1").Select
            Dim a  As Integer
            'Varre célula por célula na coluna A
            For a = 2 To .UsedRange.Rows.Count + 1
                'Variavel com o valor da célula atual
                Dim vCel As String
                vCel = Cells(a, "A")
                'Se o valor da célula for igual ao informado na planilha principal
                If vCel = vRegistro Then
                    'Exibe uma msg informando que o número já foi usado e pergunta se quer continuar
                    If MsgBox("Número de registro " & vRegistro & " já cadastrado!" & Chr(13) & _
                    "Prosseguir com a cópia?", vbQuestion + vbYesNo, "Cópia de registros") = vbYes Then
                        'Caso a resposta seja sim, grava os dados, salva e fecha a pasta de destino
                        Windows(planValidação).Activate
                        Sheets("Num_Reg").Activate
                        ultimaLinha = .UsedRange.Rows.Count + 1
                        Cells(ultimaLinha, "A") = vRegistro
                        MsgBox "Gravação de dados realizada com sucesso!", vbInformation, "Gravação de dados"
                        vRegistro = ""
                        Workbooks(planValidação).Close True
                        
                    'Caso a resposta seja não, sai da rotina
                    Else
                        MsgBox "Operação cancelada pelo usuário!", vbExclamation, "Gravação de dados"
                        Workbooks(planValidação).Close True
                        Application.ScreenUpdating = True
                        Exit Sub
                    End If
                Else
                    'Se a célula atual estiver em branco, grava os dados, salva e fecha a pasta de destino
                    If vCel = "" Then
                        Windows(planValidação).Activate
                        Sheets("Num_Reg").Activate
                         ultimaLinha = .UsedRange.Rows.Count + 1
                        Cells(ultimaLinha, "A") = vRegistro
                        MsgBox "Gravação de dados realizada com sucesso!", vbInformation, "Gravação de dados"
                        vRegistro = ""
                        Workbooks(planValidação).Close True
                    End If
                End If
            Next
            'Habilita a atualização de tela
            Application.ScreenUpdating = True
        End With
    End With
End Sub 
                                                                                                	                                                
	                                         
                    
                    	
                            Postado : 28/01/2016 10:49 am