Planilha excel vba cadastra na própria planilha 

Planilha excel vba cadastra na propria planilhas

Com esses macros Excel vba, você poderá efetuar o cadastro de cliente, fornecedores e outros que queira, usando esse exemplo. No código da folha de planilha vamos usar o evento Change para que ao digitar e Evento Selection Change ao selecionar, será adicionado determinados dados automaticamente, busca efetuada em outra folha de planilha.

    Observe os códigos abaixo

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = “$E$5” Then
Plan1.Shapes(“btSALVAR”).Visible = False
X = Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
For i = 4 To Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan1.Range(“E5”) = Plan4.Cells(i, “b”) Then
Plan1.Cells(8, “e”) = Plan4.Cells(i, “a”) ‘codigo
Plan1.Cells(10, “e”) = Plan4.Cells(i, “b”) ‘nome
Plan1.Cells(10, “n”) = Plan4.Cells(i, “c”) ‘sexo
Plan1.Cells(12, “e”) = Plan4.Cells(i, “d”) ‘endereço
Plan1.Cells(12, “n”) = Plan4.Cells(i, “e”) ‘bairro
Plan1.Cells(14, “e”) = Plan4.Cells(i, “f”) ‘cidade
Plan1.Cells(14, “L”) = Plan4.Cells(i, “g”) ‘estado
Plan1.Cells(14, “p”) = Plan4.Cells(i, “h”) ‘cep
Plan1.Cells(16, “e”) = Plan4.Cells(i, “i”) ‘faixa etaria
Plan1.Cells(16, “L”) = Plan4.Cells(i, “j”) ‘data nascimento
End If
Next i
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = “$E$5” Then
SendKeys “%{down}”
End If
End Sub

No modulo comum vamos usar os seguintes códigos, lembrando que poderá fazer o download do exemplo de planilha no final do Post.

sub sbx_novo()
X = Plan4.Cells(Rows.Count, “a”).End(xlUp).Row + 1
Plan1.Shapes(“btALTERAR”).Visible = True
‘Plan1.Unprotect ‘ caso esteja
Plan1.Cells(5, “e”) = “” ‘
Plan1.Cells(8, “e”) = “” ‘codigo
Plan1.Cells(10, “e”) = “” ‘nome
Plan1.Cells(10, “n”) = “” ‘sexo
Plan1.Cells(12, “e”) = “” ‘endereço
Plan1.Cells(12, “n”) = “” ‘bairro
Plan1.Cells(14, “e”) = “” ‘cidade
Plan1.Cells(14, “L”) = “” ‘estado
Plan1.Cells(14, “P”) = “” ‘cep
Plan1.Cells(16, “e”) = “” ‘faixa etaria
Plan1.Cells(16, “L”) = “” ‘ data nascimento
Plan1.Cells(8, “e”).Value = (X – 3)
Plan1.Cells(10, “e”).Activate
Plan1.Shapes(“btSALVAR”).Visible = True
End Sub

Sub sbx_altera_dados()
X = Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan1.Cells(10, “e”) = “” Then MsgBox ” não há registro para alterar”, vbCritical, “Escola Saberexcel VBA Estudos®”: Exit Sub
For i = 4 To Plan4.Cells(Rows.Count, “b”).End(xlUp).Row
If Plan4.Cells(i, “a”) = Plan1.Cells(8, “e”) Then
Plan4.Cells(i, “b”) = Plan1.Cells(10, “e”) ‘nome
Plan4.Cells(i, “c”) = Plan1.Cells(10, “n”) ‘sexo
Plan4.Cells(i, “d”) = Plan1.Cells(12, “e”) ‘endereço
Plan4.Cells(i, “e”) = Plan1.Cells(12, “n”) ‘bairro
Plan4.Cells(i, “f”) = Plan1.Cells(14, “e”) ‘cidade
Plan4.Cells(i, “g”) = Plan1.Cells(14, “L”) ‘estado
Plan4.Cells(i, “h”) = Plan1.Cells(14, “P”) ‘cep
Plan4.Cells(i, “i”) = Plan1.Cells(16, “e”) ‘faixa etaria’cep
Plan4.Cells(i, “j”) = Plan1.Cells(16, “L”) ‘data nascimento
End If
Next i
MsgBox (“dados foram alterados com sucesso!”), vbInformation, “Escola Saberexcel VBA Estudos®”
End Sub

Sub sbx_salvar_dados()
‘localizar a ultima linha na plan4 + 1(proxima em branco)
‘If Plan1.Cells(10, “e”).Value = “” Then MsgBox “dados incosistentes…”, vbCritical, “Escola Saberexcel VBA Estudos®”: Exit Sub
If Cells(10, “e”) = “” Or _
Cells(10, “n”) = “” Or _
Cells(12, “e”) = “” Or _
Cells(12, “n”) = “” Then
MsgBox “dados inconsistentes…”, vbCritical, “Escola Saberexcel VBA Estudos®”: Exit Sub
End If

Plan1.Shapes(“btALTERAR”).Visible = True
X = Plan4.Cells(Rows.Count, “a”).End(xlUp).Row + 1
For i = 2 To X
If Plan4.Cells(i, “a”).Value = Plan1.Cells(8, “e”) Then MsgBox “Cadastro já existente…”, vbCritical, “Escola Saberexcel VBA Estudos®”: Exit Sub
Exit For
Next i
Plan4.Cells(X, “a”) = Plan1.Cells(8, “e”) ‘codigo
Plan4.Cells(X, “b”) = Plan1.Cells(10, “e”) ‘nome
Plan4.Cells(X, “c”) = Plan1.Cells(10, “n”) ‘sexo
Plan4.Cells(X, “d”) = Plan1.Cells(12, “e”) ‘endereço
Plan4.Cells(X, “e”) = Plan1.Cells(12, “n”) ‘bairro
Plan4.Cells(X, “f”) = Plan1.Cells(14, “e”) ‘cidade
Plan4.Cells(X, “g”) = Plan1.Cells(14, “L”) ‘estado
Plan4.Cells(X, “h”) = Plan1.Cells(14, “P”) ‘cep
Plan4.Cells(X, “i”) = Plan1.Cells(16, “e”) ‘faixa etaria
Plan4.Cells(X, “j”) = Plan1.Cells(16, “L”) ‘data nascimento
MsgBox “dados foram salvos com sucesso!!”, vbInformation, “Escola Saberexcel VBA Estudos®”
‘//========’limpando para novos dados ...
Plan1.Cells(8, “e”) = “” ‘codigo
Plan1.Cells(10, “e”) = “” ‘nome
Plan1.Cells(10, “n”) = “” ‘sexo
Plan1.Cells(12, “e”) = “” ‘endereço
Plan1.Cells(12, “n”) = “” ‘bairro
Plan1.Cells(14, “e”) = “” ‘cidade
Plan1.Cells(14, “L”) = “” ‘estado
Plan1.Cells(14, “P”) = “” ‘cep
Plan1.Cells(16, “e”) = “” ‘faixa etaria
Plan1.Cells(16, “L”) = “” ‘ data nascimento
Plan1.Cells(8, “e”).Value = (X – 3)
Plan1.Cells(10, “e”).Activate
‘ Plan1.Shapes(“btSALVAR”).Visible = False
End Sub

‘busca efetuada na plan2’
Sub sby_autofiltro_masculino()
Dim i As Integer
wLin = 11
‘x = Plan2.Cells(Rows.Count, “b”).End(xlUp).Row + 2
Plan2.Range(Plan2.Cells(11, “b”), Plan2.Cells(23, “h”)).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan4.Cells(i, “c”).Value = “Masculino” Then
Plan4.Cells(i, “a”).Resize(, 7).Copy Plan2.Cells(wLin, “b”)
wLin = wLin + 1
End If
Next i
End Sub

Sub sby_autofiltro_feminino()
Dim i As Integer
wLin = 11
‘x = Plan4.Cells(Rows.Count, “b”).End(xlUp).Row + 1
Plan2.Range(Plan2.Cells(11, “b”), Plan2.Cells(23, “h”)).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan4.Cells(i, “c”).Value = “Feminino” Then
Plan4.Cells(i, “a”).Resize(, 7).Copy Plan2.Cells(wLin, “b”)
wLin = wLin + 1
End If
Next i
End Sub

‘faremos um autofiltro da da faixa etaria digita em outra folha de planilha
Sub sby_autofiltro_faixa_etaria()
Dim i As Integer
wLin = 11
‘x = Plan4.Cells(Rows.Count, “b”).End(xlUp).Row + 2
Plan2.Range(Plan2.Cells(11, “b”), Plan2.Cells(23, “h”)).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan4.Cells(i, “i”).Value = Plan2.[E3] Then
Plan4.Cells(i, “a”).Resize(, 7).Copy Plan2.Cells(wLin, “b”)
wLin = wLin + 1
End If
Next i
End Sub

‘Imprimir area de uma folha de planilha referenciada
Sub sby_imprimir()
Dim Resposta As String
Resposta = MsgBox(“deseja imprimir esta area(B11:H23)da planilha?”, vbYesNo + vbinformatin, “Escola Saberexcel VBA Estudos®”)
If Resposta = 6 Then ‘ 6 = vbyes e 7 = vbNo
ActiveSheet.PageSetup.PrintArea = “$B$11:$H$23”
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End If
End Sub

‘////=============
‘busca efetuada na plan2 e extração em outra folha de panilha com base em um critério
‘neste caso usamos a palavra feminino
Sub sby_autofiltro_masculino()
Dim i As Integer
wLin = 11
‘x = Plan2.Cells(Rows.Count, “b”).End(xlUp).Row + 2
Plan2.Range(Plan2.Cells(11, “b”), Plan2.Cells(23, “h”)).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan4.Cells(i, “c”).Value = “Masculino” Then
Plan4.Cells(i, “a”).Resize(, 7).Copy Plan2.Cells(wLin, “b”)
wLin = wLin + 1
End If
Next i
End Sub

‘Extração de dados correspondente ao critério estipulado como feminino.
Sub sby_autofiltro_feminino()
Dim i As Integer
wLin = 11
‘x = Plan4.Cells(Rows.Count, “b”).End(xlUp).Row + 1
Plan2.Range(Plan2.Cells(11, “b”), Plan2.Cells(23, “h”)).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan4.Cells(i, “c”).Value = “Feminino” Then
Plan4.Cells(i, “a”).Resize(, 7).Copy Plan2.Cells(wLin, “b”)
wLin = wLin + 1
End If
Next i
End Sub

‘fazer uma extração de dados com base em um critério em célula na planiha excel
Sub sby_autofiltro_faixa_etaria()
Dim i As Integer
wLin = 11
‘x = Plan4.Cells(Rows.Count, “b”).End(xlUp).Row + 2
Plan2.Range(Plan2.Cells(11, “b”), Plan2.Cells(23, “h”)).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, “a”).End(xlUp).Row
If Plan4.Cells(i, “i”).Value = Plan2.[E3] Then
Plan4.Cells(i, “a”).Resize(, 7).Copy Plan2.Cells(wLin, “b”)
wLin = wLin + 1
End If
Next i
End Sub

‘Imprimir área desejada da folha de planiha
Sub sby_imprimir()
Dim Resposta As String
Resposta = MsgBox(“deseja imprimir esta area(B11:H23)da planilha?”, vbYesNo + vbinformatin, “Escola Saberexcel VBA Estudos®”)
If Resposta = 6 Then ‘ 6 = vbyes e 7 = vbNo
ActiveSheet.PageSetup.PrintArea = “$B$11:$H$23”
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End If
End Sub

Seja um membro Escola Saberexcel VBA Estudos.
http://www.saberexcel.com.br      
contato@saberexcel.com.br

+ 500 Vídeo Aulas MS Excel VBA
+ 30.000 Planilhas MS Excel VBA
+ Coleção 25.000 Macros MS Excel VBA
+ 4 Módulos Como Fazer Programação MS Excel VBA
+ 151 Planilhas Instruções Loops Excel VBA
+ 341 Planilhas WorksheetFunctions Excel VBA
+ 4 Módulos Como Fazer Programação MS Excel VBA
+ Planilhas Inteligentes  – Excel VBA

Faça o Download do exemplo de Planilha.