Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Otimização de Códig...
 
Notifications
Clear all

Otimização de Código + Colar valores

 
2024 - VBA & Macros
Post Recente por Wagner Morel 6 anos atrás
6 Posts
3 Usuários
0 Reactions
1,634 Visualizações
RSS
 lognet
(@lognet)
Posts: 14
Active Member
Topic starter
 

Fala pessoal, beleza?

Dúvida simples. Preciso copiar vários valores (nem todos estão no código) e colar na última linha não preenchida de outra aba. Pesquisei bastante e cheguei no código logo abaixo, mas tem 2 pequenos problemas.

1- Preciso colar a maioria em valores. Sei que o código é "Selection.PasteSpecial Paste:=xlPasteValues" mas tentei inserir de algumas formas e não consegui.
2 - Achei o código lento, mesmo quando estava colando apenas 2 valores (em torno de 5 segundos). Alguém saberia otimizar? Temo que quando eu colocar todos os valores que passam de 60 fique mais demorado.

Desde já, obrigado!

Sub IMPORT()

Application.ScreenUpdating = False

If Range("C5").Value <> "" Then

Dim intLinha As Integer
intLinha = ThisWorkbook.Worksheets("BASE").Range("A1").Cells(Rows.Count, 1).End(xlUp).Row + 1

Dim wsOrigem As Worksheet
Dim wsDestino As Worksheet

Set wsOrigem = Worksheets("Cadastro 2")
Set wsDestino = Worksheets("BASE")

    With wsOrigem
    .Range("C5").Copy Destination:=wsDestino.Cells(intLinha, 2)
    .Range("C8").Copy Destination:=wsDestino.Cells(intLinha, 6)
    .Range("C9").Copy Destination:=wsDestino.Cells(intLinha, 7)
    .Range("C10").Copy Destination:=wsDestino.Cells(intLinha, 8)
    .Range("C11").Copy Destination:=wsDestino.Cells(intLinha, 9)
    .Range("C12").Copy Destination:=wsDestino.Cells(intLinha, 10)
    .Range("C14").Copy Destination:=wsDestino.Cells(intLinha, 11)

End With

End If
    
Application.ScreenUpdating = True

End Sub
 
Postado : 04/09/2018 8:27 am
xlarruda
 xlarruda
(@xlarruda)
Posts: 732
Honorable Member
 

Tenta Algo tipo assim:

   wsDestino.Cells(intLinha, 2).Value = wsOrigem.Range("C5").value
   wsDestino.Cells(intLinha, 6).Value = wsOrigem.Range("C8").value

Abrç!

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

Att.

André Arruda

 
Postado : 04/09/2018 8:55 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

lognet,

Boa tarde!

Veja se assim melhora a performance:

Sub IMPORT()

    Application.ScreenUpdating = False
    
    If Range("C5").Value <> "" Then
    
    Dim intLinha As Integer
    intLinha = ThisWorkbook.Worksheets("BASE").Range("A1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Sheets("Cadastro 2").Range("C5").Select
    Selection.Copy
    Sheets("BASE").Select
    Range("B" & intLinha).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Cadastro 2").Select
    Range("C8:C12,C14").Select
    Selection.Copy
    Sheets("BASE").Select
    Range("F" & intLinha).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    End If
       
    Application.ScreenUpdating = True
End Sub

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 04/09/2018 9:09 am
 lognet
(@lognet)
Posts: 14
Active Member
Topic starter
 

Fala Wagner, beleza?

Continuou colando formatação o código.

 
Postado : 05/09/2018 1:11 pm
 lognet
(@lognet)
Posts: 14
Active Member
Topic starter
 

Boa, amigo.

Funcionou, a colagem! A otimização não melhorou, mas esse era o principal. Veleu

 
Postado : 05/09/2018 1:12 pm
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

lognet,

Bom dia!

Pedimos a gentileza de não utilizar citações de inteiro teor em sua mensagens. Não há necessidade. As citações, somente se estritamente necessárias ao entendimento das mensagens, devem restringir-se a pequenos trechos.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 06/09/2018 6:56 am
Forum Jump:
  Tópico Anterior
Próximo Tópico