Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar dados de uma...
 
Notifications
Clear all

Copiar dados de uma aba para outra.

 
2024 - VBA & Macros
2 Posts
2 Usuários
0 Reactions
687 Visualizações
RSS
 ShockWave
(@shockwave)
Posts: 0
New Member
Topic starter
 

Boa noite pessoal!
É meu primeiro tópico no fórum, estou enfrentando uma dificuldade na programação da minha "primeira" macro no vba.

Preciso do seguinte: Copiar as colunas selecionadas da aba atual e transferir para a aba "Plan4", e conforme vou indo fazendo isso para cada aba ele vai colando em baixo da ultima célula preenchida. Porém ele só está transferindo o último range que eu faço. Alguém pode me ajudar a resolver este problema? Obrigado!

Sub Macro33333()
'
'Macro criada em 27/09/2016
 
 
'Copiar Código e Descição
Range("A12:B12").Select
    Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   
Range("N12").Select
    Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   
'Seleciona a planila 4
    Sheets("Plan4").Select
    Range("B1").Select
    Do
           If ActiveCell <> "" Then
            ActiveCell.Offset(1, 0).Select
            End If
        Loop Until ActiveCell = ""
        ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Application.CutCopyMode = False
        
        End Sub


https://uploaddeimagens.com.br/imagens/ ... d-png--773

https://uploaddeimagens.com.br/imagens/ ... d1-png--20

 
Postado : 27/09/2016 6:48 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se entendi corretamente, ao efetuar a segunda seleção e copia, a primeira é "descartada".

Experimente assim:

Sub Macro33333()
'
'Macro criada em 27/09/2016

Dim uLin As Integer
uLin = Sheets("Plan4").Cells(Cells.Rows.Count, "B").End(xlUp).Row
'Copiar Código e Descição
Range("A12:B12").Select
    Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
 Sheets("plan4").Range("B" & uLin).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
   
Range("N12").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("plan4").Range("D" & uLin).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Application.CutCopyMode = False
   
End Sub
 
Postado : 28/09/2016 6:13 am
Forum Jump:
  Tópico Anterior
Próximo Tópico