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.