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