Notifications
Clear all

Colar Somente valores

8 Posts
4 Usuários
0 Reactions
1,525 Visualizações
(@robertonl)
Posts: 121
Estimable Member
Topic starter
 

Boa tarde.
No código em anexo, o vlookup retorna as informações necessárias, porém tentei adapta-lo para somente a formula ficar na macro e nas células aparecer somente valores.
Realizei algumas tentativas sem sucesso.
Desejaria uma luz para resolução do mesmo.
Obs: Adaptei a macro do tópico anterior que foi concatenar valores na célula.

Sub Macro_Total()
' Criado por Denilson Roberto de Souza

Dim w As Worksheet
Dim senha As String
senha = "123"
Set w = Plan4
Dim ulinha As Long

w.Activate

    If w.ProtectContents = True Then
    
        w.Unprotect senha
    
    End If

ulinha = w.Cells(Cells.Rows.Count, 1).End(3).Row

    For i = 3 To ulinha
    
        w.Cells(i, "E") = w.Cells(i, "B") & " " & w.Cells(i, "c")
    
    
    Next i
  
Range("D3").Select
ActiveCell.Formula = "=vlookup(c3,cadastro!A:B,2,0)"
Range("c3").Select
Selection.End(xlDown).Select
lin = ActiveCell.Row
rg = "D3:D" & lin
Range("D3").Select
i = 1

Selection.AutoFill Destination:=Range(rg), Type:=xlFillDefault

cont = 3
Do Until IsEmpty(Cells(cont, 2))
   If IsError(Cells(cont, 2)) Then
       Cells(cont, 2) = " "
   End If
cont = cont + 1
Loop

'ActiveSheet.Columns(5).Delete
Do Until Len(ActiveSheet.Cells(i, 1).Text) = 0
    texto = ActiveSheet.Cells(i, 2) & " " & ActiveSheet.Cells(i, 3)
    'texto = UCase(texto)
    'fim = Len(ActiveSheet.Cells(i, 2)) + Len(ActiveSheet.Cells(i, 3)) + 2
    'ActiveSheet.Cells(i, 5) = texto
    'ActiveSheet.Cells(i, 5).Font.Name = "Calibri"
    'ActiveSheet.Cells(i, 5).Font.Size = 10
    'ActiveSheet.Cells(i, 5).Characters(Start:=1, Length:=fim).Font.FontStyle = "Bold"
    i = i + 1
Loop

w.Protect senha

    
End Sub
 
Postado : 16/03/2018 11:35 am
xlarruda
(@xlarruda)
Posts: 732
Honorable Member
 

Tente assim:

ActiveCell.Formula = "=vlookup(c3,cadastro!A:B,2,0)"
Activecell.Value = Activecell.Value

' INSERIR ESSA LINHA

Abrç!

___________________________________________________________________________________________
Se a resposta atendeu sua dúvida, por favor, clique no Gostei e marque o Tópico como [Resolvido].

Att.

André Arruda

 
Postado : 16/03/2018 12:18 pm
(@robertonl)
Posts: 121
Estimable Member
Topic starter
 

A orientação proposta para acrescentar esta linha não surgiu efeito.
Porém utilizei a orientação proposta abaixo desta linha, porém somente a primeira linha que manteve a informação, as demais ficaram com a formula.

Selection.AutoFill Destination:=Range(rg), Type:=xlFillDefault

 
Postado : 17/03/2018 7:35 pm
(@mprudencio)
Posts: 2749
Famed Member
 

Faça o seguinte

Ative o gravador de macros

Selecione toda a planilha clicando entre os numeros da linha e as letras da coluna

Copie e cole valores no mesmo local

Esc

Pare o gravador

Abra o editor de VBA

Apos loop coloque

Call macro1

Ficando assim

loop
call macro1
w.protect senha

end sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 18/03/2018 8:23 am
(@klarc28)
Posts: 971
Prominent Member
 
Sub Macro1()
'
' Macro1 Macro
'

'
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub
 
Postado : 18/03/2018 10:35 am
(@robertonl)
Posts: 121
Estimable Member
Topic starter
 

Boa noite.
Desculpe pelo inconveniente, porém tentei seguir as orientações solicitadas e não obtive sucesso.
Incluir na planilha as macros necessárias para executar os cálculos desejados, porém deparei com um problema que tentei resolver e não obtive sucesso.
1º Ponto: A formula ficar somente na macro e na planilha ficar somente valores.
2º Ponto: As células com informação foi aplicado uma formatação condicional, porém a macro está realizando uma formatação condicional em células que estão sem valor.
A ideia principal é ela preencher somente onde contém dados.Ficarei agradecido pela ajuda de vocês.
Caso o projeto vba solicite senha (123)

Pessoal, devido arquivo compactado ser grande segue o código fonte no qual utilizei.

Sub Atualiza_Estoque()
'
' Atualiza_Lançamentos Macro
' Atualiza Informação de Estoque
'

Range("b3").Select
ActiveCell.Formula = "=vlookup(a3,cadastro!A:D,2,0)"
Range("a3").Select
Selection.End(xlDown).Select
lin = ActiveCell.Row
rg = "b3:b" & lin
ActiveCell.Value = ActiveCell.Value
Range("b3").Select
Selection.AutoFill Destination:=Range(rg), Type:=xlFillDefault

Range("c3").Select
ActiveCell.Formula = "=vlookup(a3,cadastro!A:D,3,0)"
Range("a3").Select
Selection.End(xlDown).Select
lin1 = ActiveCell.Row
rg1 = "c3:c" & lin1
ActiveCell.Value = ActiveCell.Value
Range("c3").Select
Selection.AutoFill Destination:=Range(rg1), Type:=xlFillDefault

Range("d3").Select
ActiveCell.Formula = "=vlookup(a3,cadastro!A:D,4,0)"
Range("a3").Select
Selection.End(xlDown).Select
lin2 = ActiveCell.Row
rg2 = "d3:d" & lin2
ActiveCell.Value = ActiveCell.Value
Range("d3").Select
Selection.AutoFill Destination:=Range(rg2), Type:=xlFillDefault
cont = 3

Do Until IsEmpty(Cells(cont, 2))
   If IsError(Cells(cont, 2)) Then
       Cells(cont, 2) = " "
   End If
    Range("E3").Select
    ActiveCell.Formula = "=SUMIF(Cadastro!a:e,A3,cadastro!e:e)+SUMIF(Lançamentos!F:G,""ENTRADA""&"" ""&A3,Lançamentos!G:G)-(SUMIF(Lançamentos!F:G,""SAIDA""&"" ""&A3,Lançamentos!G:G))"
    Range("A3").Select
    ActiveCell.Value = ActiveCell.Value
    Selection.End(xlDown).Select
    lin3 = ActiveCell.Row
    rg3 = "e3:e" & lin3
    ActiveCell.Value = ActiveCell.Value
    Range("e3").Select
    Selection.AutoFill Destination:=Range(rg3), Type:=xlFillDefault
    finalrow = Cells(Rows.Count, 3).End(xlDown).Row
cont = cont + 1
    Loop
    For i = 3 To finalrow
  With Plan6
   If .Cells(i, 5) < .Cells(i, 3) Then
    .Cells(i, 6) = "Estoque Critico"
    .Cells(i, 1).Resize(i, 6).Interior.ColorIndex = 3
    .Cells(i, 1).Resize(, 6).Font.Bold = True
        
    Else
        If .Cells(i, 5) > .Cells(i, 4) Then
        .Cells(i, 6) = "Estoque Excesso"
        .Cells(i, 1).Resize(, 6).Interior.ColorIndex = 8
        .Cells(i, 1).Resize(, 6).Font.Bold = True
       
        Else
            If .Cells(i, 5) > .Cells(i, 3) And .Cells(i, 5) < .Cells(i, 4) Then
            .Cells(i, 6) = "Estoque Bom"
            .Cells(i, 1).Resize(, 6).Interior.ColorIndex = 2
            .Cells(i, 1).Resize(, 6).Font.Bold = True
            End If
        End If
  End If

End With
Next i

'w.Protect senha
End Sub



Sub Atualiza_Lançamentos()
'
' Atualiza_Lançamentos Macro
' Atualiza Lançamento de Entradas e Saidas de Material de Embalagem Criado por Denilson Roberto de Souza
'

'
Dim w As Worksheet
Dim senha As String
senha = "123"
Set w = Plan3
Dim ulinha As Long

w.Activate

    If w.ProtectContents = True Then
    
        w.Unprotect senha
    
    End If

ulinha = w.Cells(Cells.Rows.Count, 1).End(3).Row

    For i = 3 To ulinha
    
        w.Cells(i, "F") = w.Cells(i, "B") & " " & w.Cells(i, "D")
        
    Next i
  
Range("e3").Select
ActiveCell.Formula = "=vlookup(D3,cadastro!A:B,2,0)"
'ActiveCell.Value = ActiveCell.Value
Range("d3").Select

ActiveCell.Value = ActiveCell.Value
Selection.End(xlDown).Select
lin = ActiveCell.Row
rg = "e3:e" & lin
ActiveCell.Value = ActiveCell.Value
Range("e3").Select
Range("e3").Copy
'i = 1
'Selecao2.Select
    'Selecao2.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Selection.AutoFill Destination:=Range(rg), Type:=xlFillDefault

cont = 3
Do Until IsEmpty(Cells(cont, 2))
   If IsError(Cells(cont, 2)) Then
       Cells(cont, 2) = " "
   End If
cont = cont + 1
Loop



w.Protect senha

End Sub



 
Postado : 20/03/2018 1:01 am
(@klarc28)
Posts: 971
Prominent Member
 

Quando enviar código, aperte o botão Code.

 
Postado : 20/03/2018 7:03 am
(@robertonl)
Posts: 121
Estimable Member
Topic starter
 
 Sub Atualiza_Estoque()
'
' Atualiza_Lançamentos Macro
' Atualiza Informação de Estoque
'

Range("b3").Select
ActiveCell.Formula = "=vlookup(a3,cadastro!A:D,2,0)"
Range("a3").Select
Selection.End(xlDown).Select
lin = ActiveCell.Row
rg = "b3:b" & lin
ActiveCell.Value = ActiveCell.Value
Range("b3").Select
Selection.AutoFill Destination:=Range(rg), Type:=xlFillDefault

Range("c3").Select
ActiveCell.Formula = "=vlookup(a3,cadastro!A:D,3,0)"
Range("a3").Select
Selection.End(xlDown).Select
lin1 = ActiveCell.Row
rg1 = "c3:c" & lin1
ActiveCell.Value = ActiveCell.Value
Range("c3").Select
Selection.AutoFill Destination:=Range(rg1), Type:=xlFillDefault

Range("d3").Select
ActiveCell.Formula = "=vlookup(a3,cadastro!A:D,4,0)"
Range("a3").Select
Selection.End(xlDown).Select
lin2 = ActiveCell.Row
rg2 = "d3:d" & lin2
ActiveCell.Value = ActiveCell.Value
Range("d3").Select
Selection.AutoFill Destination:=Range(rg2), Type:=xlFillDefault
cont = 3

Do Until IsEmpty(Cells(cont, 2))
If IsError(Cells(cont, 2)) Then
Cells(cont, 2) = " "
End If
Range("E3").Select
ActiveCell.Formula = "=SUMIF(Cadastro!a:e,A3,cadastro!e:e)+SUMIF(Lançamentos!F:G,""ENTRADA""&"" ""&A3,Lançamentos!G:G)-(SUMIF(Lançamentos!F:G,""SAIDA""&"" ""&A3,Lançamentos!G:G))"
Range("A3").Select
ActiveCell.Value = ActiveCell.Value
Selection.End(xlDown).Select
lin3 = ActiveCell.Row
rg3 = "e3:e" & lin3
ActiveCell.Value = ActiveCell.Value
Range("e3").Select
Selection.AutoFill Destination:=Range(rg3), Type:=xlFillDefault
finalrow = Cells(Rows.Count, 3).End(xlDown).Row
cont = cont + 1
Loop
For i = 3 To finalrow
With Plan6
If .Cells(i, 5) < .Cells(i, 3) Then
.Cells(i, 6) = "Estoque Critico"
.Cells(i, 1).Resize(i, 6).Interior.ColorIndex = 3
.Cells(i, 1).Resize(, 6).Font.Bold = True

Else
If .Cells(i, 5) > .Cells(i, 4) Then
.Cells(i, 6) = "Estoque Excesso"
.Cells(i, 1).Resize(, 6).Interior.ColorIndex = 8
.Cells(i, 1).Resize(, 6).Font.Bold = True

Else
If .Cells(i, 5) > .Cells(i, 3) And .Cells(i, 5) < .Cells(i, 4) Then
.Cells(i, 6) = "Estoque Bom"
.Cells(i, 1).Resize(, 6).Interior.ColorIndex = 2
.Cells(i, 1).Resize(, 6).Font.Bold = True
End If
End If
End If

End With
Next i

'w.Protect senha
End Sub



Sub Atualiza_Lançamentos()
'
' Atualiza_Lançamentos Macro
' Atualiza Lançamento de Entradas e Saidas de Material de Embalagem Criado por Denilson Roberto de Souza
'

'
Dim w As Worksheet
Dim senha As String
senha = "123"
Set w = Plan3
Dim ulinha As Long

w.Activate

If w.ProtectContents = True Then

w.Unprotect senha

End If

ulinha = w.Cells(Cells.Rows.Count, 1).End(3).Row

For i = 3 To ulinha

w.Cells(i, "F") = w.Cells(i, "B") & " " & w.Cells(i, "D")

Next i

Range("e3").Select
ActiveCell.Formula = "=vlookup(D3,cadastro!A:B,2,0)"
'ActiveCell.Value = ActiveCell.Value
Range("d3").Select

ActiveCell.Value = ActiveCell.Value
Selection.End(xlDown).Select
lin = ActiveCell.Row
rg = "e3:e" & lin
ActiveCell.Value = ActiveCell.Value
Range("e3").Select
Range("e3").Copy
'i = 1
'Selecao2.Select
'Selecao2.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.AutoFill Destination:=Range(rg), Type:=xlFillDefault

cont = 3
Do Until IsEmpty(Cells(cont, 2))
If IsError(Cells(cont, 2)) Then
Cells(cont, 2) = " "
End If
cont = cont + 1
Loop



w.Protect senha

End Sub
 
Postado : 20/03/2018 7:46 am