Saberexcel - o site de quem precisa aprender Macros MS Excel VBA
Esse Exemplo de planilha do Aplicativo Microsoft Excel VBA(Visual Basic Application), contém macros que fazem um sistema de cadastro usando a própria folha de planilha com base de entrada de dados, e envia para uma outra planilha, (específica )
Sub Salvando_dados()
'envia dados da planilha1 baseado dados escritos na planilha 2
Application.ScreenUpdating = False
Dim sbProjeto As Integer
Dim sbEndereco As String
Dim sbNumTelefone As String
Dim sbLinha As Long
Dim sbLocaliza As Boolean
'recuperando o número da variavel sbProjeto
sbProjeto = Range("E3").Value
'Recupere o novo endereço e telefone numeram a informação
sbEndereco = Range("D5").Value
sbNumTelefone = Range("D7").Value
'Mova-se a Plan1 para salvar as modificações
Sheets("Plan1").Select
sbLocaliza = False
sbLinha = 2
Do While sbLocaliza = False
'Correspondência encontrada com projeto, agora atualize o endereço e telefone numeram a informação
If Range("A" & sbLinha).Value = sbProjeto Then
sbLocaliza = True
Range("C" & sbLinha).Value = sbEndereco
Range("D" & sbLinha).Value = sbNumTelefone
'Encontrado um número de projeto em branco (assunção de fim de lista em Plan1)
ElseIf IsEmpty(Range("A" & sbLinha).Value) = True Then
MsgBox ("Nenhum dado foi encontrado. As modificações não foram feitas.")
Exit Sub
End If
sbLinha = sbLinha + 1
Loop
'selecionando a planilha Plan2
Sheets("Plan2").Select
Range("D5").Select
MsgBox ("Salvo com sucesso.")
Application.ScreenUpdating = True
End Sub
Sub Populate Data()
Application.ScreenUpdating = False
Dim sbProjeto As Integer
Dim sbEndereco As String
Dim sbNumTelefone As String
Dim sbLinha As Long
Dim sbLocaliza As Boolean
'Guardando o valor a uma variável
sbProjeto = Range("E3").Value
'seleciona a planilha Plan1
Sheets("Plan1").Select
sbLocaliza = False
sbLinha = 2
Do While sbLocaliza = False
'Correspondência encontrada com projeto, agora atualize o endereço e telefone numeram a informação em Plan2
If Range("A" & sbLinha).Value = sbProjeto Then
sbLocaliza = True
sbEndereco = Range("C" & sbLinha).Value
sbNumTelefone = Range("D" & sbLinha).Value
Sheets("Plan2").Select
Range("D5").Value = sbEndereco
Range("D7").Value = sbNumTelefone
'Encontrado um número de projeto em branco (assunção de fim de lista em Plan1)
ElseIf IsEmpty(Range("A" & sbLinha).Value) = True Then
MsgBox ("Nenhum dado foi encontrado para a seleção de caixa de banda.")
Exit Sub
End If
sbLinha = sbLinha + 1
Loop
Application.ScreenUpdating = True
End Sub
Sub Adicionando_novos_dados()
'Os dados de atualização em Plan1 baseado no novo cliente entraram em Plan2
Application.ScreenUpdating = False
Dim sbPersonalizar As String
Dim sbProjeto As Integer
Dim sbEndereco As String
Dim sbNumTelefone As String
Dim sbLinha As Long
Dim sbLocaliza As Boolean
'Antes de acrescentar novo cliente, assegure-se que um valor foi introduzido
If IsEmpty(Range("D12").Value) = False Then
'retorna nova informação
sbPersonalizar = Range("D12").Value
sbProjeto = Range("D14").Value
sbEndereco = Range("D16").Value
sbNumTelefone = Range("D18").Value
'selecionando a Plan1 para salvar as modificações
Sheets("Plan1").Select
sbLocaliza = False
sbLinha = 2
Do While sbLocaliza = False
'Encontrado um número de projeto em branco (assunção de fim de lista em Plan1)
If IsEmpty(Range("A" & sbLinha).Value) = True Then
sbLocaliza = True
End If
sbLinha = sbLinha + 1
Loop
Range("A" & sbLinha - 1).Value = sbProjeto
Range("B" & sbLinha - 1).Value = sbPersonalizar
Range("C" & sbLinha - 1).Value = sbEndereco
Range("D" & sbLinha - 1).Value = sbNumTelefone
'Reposição atrás quanto a Plan2
Sheets("Plan2").Select
'Update range for combo boxes
ActiveSheet.Shapes("Drop Down 3").Select
With Selection
.ListFillRange = "Plan1!$B$2:$B$" & sbLinha - 1
End With
ActiveSheet.Shapes("Drop Down 8").Select
With Selection
.ListFillRange = "Plan1!$B$2:$B$" & sbLinha - 1
End With
'Limpando as entradas de dados
Range("D12").Value = ""
Range("D14").Value = ""
Range("D16").Value = ""
Range("D18").Value = ""
Range("D12").Select
MsgBox ("Novo nome adicionado com sucesso!.")
End If
Application.ScreenUpdating = True
End Sub
Sub Deletando_dados()
Application.ScreenUpdating = False
'Elimine dados em Plan1 do cliente escolhido em Plan2
Dim sbProjeto As Integer
Dim sbLinha As Long
Dim sbLocaliza As Boolean
'Recupere o número de número de projeto
sbProjeto = Range("E23").Value
'Mova-se a Plan1 para eliminar o cliente
Sheets("Plan1").Select
sbLocaliza = False
sbLinha = 2
Do While sbLocaliza = False
'Correspondência encontrada com projeto, agora elimine a entrada de cliente
If Range("A" & sbLinha).Value = sbProjeto Then
sbLocaliza = True
Rows(sbLinha & ":" & sbLinha).Select
Selection.Delete Shift:=xlUp
'Encontrado um número no projeto em branco (fim de lista em Plan1)
ElseIf IsEmpty(Range("A" & sbLinha).Value) = True Then
MsgBox ("não encontrado.")
Exit Sub
End If
sbLinha = sbLinha + 1
Loop
'selecionando planilha Plan2
Sheets("Plan2").Select
Range("E23").Value = ""
MsgBox ("Nome deletado com sucesso.")
Application.ScreenUpdating = True
End Sub
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel
Baixe o exemplo de planilha microsoft Excel VBA com as macros acima
Excel planilhas vba cadastro cadastrando na propria planilha (27.74 kB)