Notifications
Clear all

Salvar uma Informação em 2 plan

4 Posts
2 Usuários
0 Reactions
842 Visualizações
 luli
(@luli)
Posts: 18
Active Member
Topic starter
 

Boa noite a todos!
Minha duvida é: tenho um userform Negociação, e com o botão salvar dados, quero que alimente 2 plan, a plan1 e a plan26
criei um procedimento de rotina que, vou colocar o codigo a baixo, poderem os dois codigos estão funcionando, só que juntos eles não funcionan, exemplo:

ele captura um nome e nessa linha ele faz substituição e acrescenta alguns dados, só que quando tento fazer os dois codigos funcionar o mesmo tempo em uma plan ele pesquisa o cliente e coloca na linha certa, mas no outro ele joga as informação referente a linha da outra plan, ele não captura o cliente para colocar na mesma linha, separados os dois funcionam correto juntos não da certo...

Plan1.Select <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("A2").Select

Dim AMD As Long
Dim MD As Worksheet

Set MD = Worksheets("Cadastro_de_Clientes")
Range("a2").Select

While ActiveCell <> ""
If cbCodCliente.Text = ActiveCell Then
If MsgBox("CLIENTE JÁ EXITE, DESEJA SUBSTITUIR?", vbYesNo) = vbYes Then
AMD = ActiveCell.Row

MD.Cells(AMD, 110).Value = Me.txtValorTotal.Value
MD.Cells(AMD, 111).Value = Me.cbFormaPgto.Value
MD.Cells(AMD, 112).Value = Me.TextBox1.Value
MD.Cells(AMD, 113).Value = Me.cbCondPgto.Value
MD.Cells(AMD, 114).Value = Me.txtValorEntrada.Value
MD.Cells(AMD, 115).Value = Me.txtValorParcela.Value
MD.Cells(AMD, 116).Value = Me.txtTotalFinanciamento.Value
MD.Cells(AMD, 117).Value = Me.txtVencimentoParcela.Value

Exit Sub
End If
End If
ActiveCell.Offset(1, 0).Activate
Wend

If cbPesqNomeCliente.Value = "" Then
'MsgBox " SELECIONE ALGUM NOME PARA PODER CADASTRAR!"
Exit Sub
End If
AMD = ActiveCell.Row

MD.Cells(AMD, 110).Value = Me.txtValorTotal.Value
MD.Cells(AMD, 111).Value = Me.cbFormaPgto.Value
MD.Cells(AMD, 112).Value = Me.TextBox1.Value
MD.Cells(AMD, 113).Value = Me.cbCondPgto.Value
MD.Cells(AMD, 114).Value = Me.txtValorEntrada.Value
MD.Cells(AMD, 115).Value = Me.txtValorParcela.Value
MD.Cells(AMD, 116).Value = Me.txtTotalFinanciamento.Value
MD.Cells(AMD, 117).Value = Me.txtVencimentoParcela.Value

Plan26.Select<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Range("A2").Select

Dim iRow As Long
Dim WS As Worksheet

Set WS = Worksheets("Orçamentos_BD")
Range("a2").Select

While ActiveCell <> ""
If cbCodCliente.Text = ActiveCell Then
If MsgBox("CLIENTE JÁ EXITE, DESEJA SUBSTITUIR?", vbYesNo) = vbYes Then
iRow = ActiveCell.Row

WS.Cells(iRow, 1).Value = Me.cbCodCliente
WS.Cells(iRow, 2).Value = Me.cbPesqNomeCliente.Value
WS.Cells(iRow, 3).Value = Me.cx_NomeProjetista.Value
WS.Cells(iRow, 4).Value = Me.cx_NomeNegociador.Value
WS.Cells(iRow, 5).Value = Me.txtValorTotal.Value
WS.Cells(iRow, 6).Value = Me.TextBox1.Value
WS.Cells(iRow, 7).Value = TextBox2.Value
WS.Cells(iRow, 8).Value = Me.cbCondPgto.Value
WS.Cells(iRow, 9).Value = Me.cbFormaPgto.Value
WS.Cells(iRow, 10).Value = Me.txtValorEntrada.Value
WS.Cells(iRow, 11).Value = Me.txtVencimentoParcela.Value
WS.Cells(iRow, 12).Value = Me.txtPorcentagem.Value
WS.Cells(iRow, 13).Value = Me.txtValorFinanciar.Value

MsgBox "Cliente Substituido com Sucesso!!!", , ""
Exit Sub
End If
End If
ActiveCell.Offset(1, 0).Activate
Wend

If cbPesqNomeCliente.Value = "" Then
MsgBox " SELECIONE ALGUM NOME PARA PODER CADASTRAR!"
Exit Sub
End If
iRow = ActiveCell.Row

WS.Cells(iRow, 1).Value = Me.cbCodCliente
WS.Cells(iRow, 2).Value = Me.cbPesqNomeCliente.Value
WS.Cells(iRow, 3).Value = Me.cx_NomeProjetista.Value
WS.Cells(iRow, 4).Value = Me.cx_NomeNegociador.Value
WS.Cells(iRow, 5).Value = Me.txtValorTotal.Value
WS.Cells(iRow, 6).Value = Me.TextBox1.Value
WS.Cells(iRow, 7).Value = TextBox2.Value
WS.Cells(iRow, 8).Value = Me.cbCondPgto.Value
WS.Cells(iRow, 9).Value = Me.cbFormaPgto.Value
WS.Cells(iRow, 10).Value = Me.txtValorEntrada.Value
WS.Cells(iRow, 11).Value = Me.txtVencimentoParcela.Value
WS.Cells(iRow, 12).Value = Me.txtPorcentagem.Value
WS.Cells(iRow, 13).Value = Me.txtValorFinanciar.Value

se alguém puder me ajudar, peço desculpa por ficar peguntando essas coisas que sei que é fácil, mas sozinho não sei fazer, não consigo... Agradeço pela oportunidade...

 
Postado : 07/07/2016 7:30 pm
engeel2014
(@engeel2014)
Posts: 207
Estimable Member
 

É possível você postas a sua planilha? assim fica mais fácil para o pessoal avaliar e te ajudar.

Lucélio Ferreira dos Santos
Eng. Eletricista
CREA: DF-7165/TD
[email protected]

 
Postado : 07/07/2016 11:45 pm
 luli
(@luli)
Posts: 18
Active Member
Topic starter
 

Bom dia!

Segue minha planilha em anexo, para sua analise...

também estou com outro problema, ao carregar informações da plan para a combobox pesquisa : isso acontece quando a plan não tem informação nenhuma, no End(xlDown) não carrega e pede para fechar e no End(xlUP) não carrega

Dim QuantasLinhas As Long, Cont As Long
QuantasLinhas = Plan3.Range("b2").End(xlDown).Row<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Se esta dessa forma , quando vou iniciar o userform ele trava e pede para reiniciar ou fechar,
For Cont = 2 To QuantasLinhas
If Range("ap" & Cont).Value = "" Then cmbPesquisaClientes.AddItem Range("b" & Cont)
Next Cont

Dim QuantasLinhas As Long, Cont As Long
QuantasLinhas = Plan3.Range("b2").End(xlUP).Row<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< se esta dessa outra não carraga as informações da plan quando pesquiso esta zerado
For Cont = 2 To QuantasLinhas
If Range("ap" & Cont).Value = "" Then cmbPesquisaClientes.AddItem Range("b" & Cont)
Next Cont

Quando ao salvar queria salvar em dois destino ao usar o botão salvar, mas se tiver o nome em uma das plan , substituir e na outra salvar e vice e versa...

também se tiver alguma outra coisa que possa melhorar fico agradecido...

atenciosamente,

 
Postado : 08/07/2016 5:51 am
engeel2014
(@engeel2014)
Posts: 207
Estimable Member
 

No seu código você referencia a Plan1 e Plan26, porém não encontrei estas sheets na sua planilha.

Lucélio Ferreira dos Santos
Eng. Eletricista
CREA: DF-7165/TD
[email protected]

 
Postado : 13/07/2016 6:43 am