Código vba

Excel Avançado

Minha pergunta é simples: tenho um conjunto de código VBA que buscam valores numa planilha e transporta para outro. Funciona bem, contudo gostaria que onde não houvesse dados na célula não fosse retornado ZERO na outra planilha. Gostaria que fosse retornado NADA OU CÉLULA EM BRANCO.

Sub Gravar_Recebimento()
'Impede a gravação se o Pedido em Vendas "k13" for VAZIO
Sheets("Recebimento").Unprotect "M1226a3646g5780S122636465780RecriaPI"
If Sheets("Vendas").Range("K13") = vbNullString Then
MsgBox "Use o botão GRAVAR VENDAS primeiramente.", vbOKOnly, "Aviso"
Sheets("Vendas").Range("K13").Select
Exit Sub
Else: End If

If WorksheetFunction.CountA(Sheets("Vendas").Range("Q17:Q26")) = 0 Then
MsgBox "Você esqueceu de digitar o valor recebido.", vbOKOnly, "Aviso"
Exit Sub
Else: End If

If ckvendaclick = True Then
ckvendaclick = False
Else
MsgBox "Gravar venda primeiro.", vbCritical, "Aviso"
MsgBox "Recebimento não efetuado.", vbOKOnly, "Aviso"
Exit Sub
End If

 

Dim ws_rel As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim Data As Date
Dim horario As Double
Dim NPedido As Double
Dim Total As Double
Dim CredDinheiro As Double
Dim RecDinheiro As Double
Dim RecBrutoDin As Double
Dim RecCartaoCredito As Double
Dim CredCartaoDebito As Double
Dim CredCartaoCredito As Double
Dim RecCartaoDebito As Double
Dim CredCheque As Double
Dim RecCrediario As Double
Dim CredOutros As Double
Dim RecCheque As Double
Dim Troco As Double
Dim Nome As String
Dim UltimaCel As Integer

Dim QuantDados As Integer
Dim linha As Integer
validacao = 0
QuantDados = Sheets("Vendas").Range("N22").End(xlUp).Row
linha = 17
While linha < QuantDados + 1

Sheets("Vendas").Select
Data = Range("K7").Value
Nome = Range("F11").Value
horario = Range("K9").Value
NPedido = Range("K13").Value
Total = Range("N17").Value
RecDinheiro = Range("U18").Value
RecBrutoDin = Range("Q17").Value
CredDinheiro = Range("Q22").Value
RecCartaoCredito = Range("Q18").Value
CredCartaoCredito = Range("Q23").Value
RecCartaoDebito = Range("Q19").Value
CredCartaoDebito = Range("Q24").Value
RecCrediario = Range("Q20").Value
CredCheque = Range("Q25").Value
RecCheque = Range("Q21").Value
CredOutros = Range("Q26").Value
Troco = Range("R17").Value

Sheets("Recebimento").Select

UltimaCel = Range("D65000").End(xlUp).Row + 1
Range("D" & UltimaCel).Value = Data
Range("E" & UltimaCel).Value = Time
Range("F" & UltimaCel).Value = NPedido
Range("G" & UltimaCel).Value = Total
Range("H" & UltimaCel).Value = RecDinheiro
Range("I" & UltimaCel).Value = RecCartaoCredito
Range("X" & UltimaCel).Value = RecBrutoDin
Range("J" & UltimaCel).Value = RecCartaoDebito
Range("K" & UltimaCel).Value = RecCrediario
Range("L" & UltimaCel).Value = RecCheque
Range("M" & UltimaCel).Value = CredDinheiro
Range("W" & UltimaCel).Value = CredCartaoCredito
Range("O" & UltimaCel).Value = CredCartaoDebito
Range("AA" & UltimaCel).Value = CredCheque
Range("Q" & UltimaCel).Value = CredOutros
Range("R" & UltimaCel).Value = Troco
Range("S" & UltimaCel).Value = Nome
linha = linha + 1
Wend

Dim j As Integer
For j = 1 To 11 Step 2
If Sheets("Recebimento").Range("F1").Cells(UltimaCel, j) < 1 Then
Sheets("Recebimento").Range("F1").Cells(UltimaCel, j) = ClearContents
Else: End If
Next j


With Sheets("Vendas")
.Range("E17:E31").ClearContents
.Range("H17:I31").ClearContents
.Range("K13").ClearContents
.Range("G11").ClearContents
.Range("Q17").ClearContents
.Range("Q18").ClearContents
.Range("p32").ClearContents
.Range("Q19").ClearContents
.Range("Q20").ClearContents
.Range("Q21:Q26").ClearContents
.Activate
.Range("K13").Select
End With
'FINAL

Sheets("Vendas").Select
Range("K13").Select


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Sheets("Recebimento").Protect "M1226a3646g5780S122636465780RecriaPI"

End Sub

 

 

 

Muito obrigado, Marco.

Foto de Marco G.
Marco perguntou há 4 anos

Sabe a resposta?

Ganhe 10 pts por resposta de qualidade
Responder dúvida
1 resposta
1
votos
1 usuário votou nessa resposta como útil.
Professor Ian F.
Identidade verificada
  • CPF verificado
  • E-mail verificado
Respondeu há 4 anos
Melhor resposta
Essa foi a melhor resposta, escolhida pelo autor da dúvida
Bom dia Marcos, Se eu entendi bem, a planilha "recebimento" é para onde voce copia os dados, da coluna D a Coluna S. Cria uma pequeno laço 'for each' no final do seu codigo, da seguinte forma: For each cell in sheets("recebimentos").range(intervalo onde os dados estao) If cell.value = 0 then cell.value = "Celula em Branco" End if Next cell Entao onde tiver 0 sera substituido pelo texto desejado. Qualquer duvida é so chamar! Abs

Envie uma dúvida gratuitamente

Envie sua primeira dúvida gratuitamente aqui no Tira-dúvidas Profes. Nossos professores particulares estão aqui para te ajudar.

Professores particulares de Excel

+ Ver todos
Encontre professor particular para te ajudar nos estudos
R$ 75 / h
Ian F.
Fortaleza / CE
Ian F.
Identidade verificada
  • CPF verificado
  • E-mail verificado
1ª hora grátis
Introdução ao Excel Excel - Pacote Office Excel para Iniciantes
Graduação: Engenharia de Mecatrônica (Instituto Federal do Ceará)
Professor de Excel Básico ao Avançado e outras ferramentas do pacote Office. Grande experiência com planilhas personalidades e projetos para empresas.
R$ 50 / h
Vilson B.
Ji-Paraná / RO
Vilson B.
5,0 (41 avaliações)
Horas de aulas particulares ministradas 95 horas de aula
Tarefas resolvidas 27 tarefas resolvidas
Identidade verificada
  • CPF verificado
  • E-mail verificado
1ª hora grátis
Excel Básico Excel Intermediário Excel Avançado
Mestrado: Assessoria de Administração (Instituto Politécnico do Porto)
Conheça meu método inovador "excel mão na massa" que criei para ajudar quem precisa aprender rápido e sair na frente nas vagas de emprego e trabalho!
R$ 120 / h
Johny L.
Fortaleza / CE
Johny L.
4,3 (36 avaliações)
Horas de aulas particulares ministradas 94 horas de aula
Tarefas resolvidas 29 tarefas resolvidas
Identidade verificada
  • CPF verificado
  • E-mail verificado
Excel Intermediário Excel para Adolescentes Excel Básico
Graduação: Engenharia Civil (IFCE - Campus Fortaleza)
Professor da UFC - Aulas de estatística práticas e aplicadas ao mercado de trabalho além de acadêmico