Copiar dados para outra aba sem substituir dados existentes

Question

Olá, tenho em uma aba, um tipo de cadastro que busca os dados de uma pessoa, os dados de produtos calculados para venda e seus resultados.

Gostaria de copiar os dados das células C7 até a O32 que é o intervalo que contém os dados.

Gostaria de copiar com a formataçao correta. 

Sub Copiar_Dados()

Dim vLinha As Integer
Dim vColACelulas As String
Dim vContinuar As Boolean

'Seleciona Plan1
Sheets("Menu").Select
Range("A2").Select

'inicializando variáveis
vContinuar = True
vLinha = 2

While vContinuar = True

vLinha = vLinha + 1
vColACelulas = "A" & CStr(vLinha)

'encontrando uma célula em branco, não continua
If Len(Range(vColACelulas).Value) = 0 Then
vContinuar = False
End If

'A primeira ocorrência encontrada que não combinou com a célula valor de A2, não continua
If Range("A2").Value <> Range(vColACelulas).Value Then
vContinuar = False
End If

Wend

'Dados da cópia de colunas A - C
Range("A6:O31" & CStr(vLinha - 1)).Select
Selection.Copy

'cola na planilha(Plan2) na célula (A1)
Sheets("concluidos").Select
Range("A1").Select
ActiveSheet.Paste

MsgBox "Dados copiados com sucesso"

End Sub

O código acima (o qual encontrei na net, pois não entendo nada de VBA), copia os dados mas perde as referencias pois a maioria dos campos contém fórmulas.

Outra coisa, quando copio a segunda vez, os dados que estavam na aba de destino, são substituidos.

Queria que eles fossem inseridos abaixo dos que estavam na aba de destino.

Desculpem se não fui suficientemente claro,

Desde já agradeço

Answer 1

Apenas altere os valores das constantes do código abaixo e teste o código:

Sub Exemplo()
    Const c_sIntervalo As String = "C7:O32"
    Const c_sOrigem As String = "PlanilhaOrigem"
    Const c_sDestino As String = "PlanilhaDestino"
    Dim r As Range
    
    For Each r In Sheets(c_sDestino).Range(c_sIntervalo)
        If r = "" Then
            r = Sheets(c_sOrigem).Range(r.Address)
        End If
    Next r
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Muito obrigado pela dica, mas o código copia somente uma vez, não está nem substituindo. Só copia novamente se eu deletar todos os registros inseridos anteriormente. E também não copia a formatação (cores e bordas) - mas isto é o de menos.

Desculpe pela falta de instrução para com o assunto.

Att: Alex

Answer 3

Boa tarde Amigo...

Seguinte... Tenta esse codigo... Trocando apenas os numeros para adequar ao seu caso. Certeza vai dar certo... 8)

Private Sub CopiaCola()

' local de onde vira as informacoes
Dim CopiaLinhaIni As Integer
Dim CopiaLinhaFin As Integer
Dim CopiaColunaIni As Integer
Dim CopiaColunaFin As Integer

' exemplo de localizacao de copia
CopiaLinhaIni = 4
CopiaColunaIni = 3
CopiaLinhaFin = 11
CopiaColunaFin = 6

' local para as informacoes serem coladas
Dim ColaLinhaIni As Integer
Dim ColaColunaIni As Integer

' exemplo de localizacao para colagem
ColaLinhaIni = 4
ColaColunaIni = 3

' seta o objeto das planilhas
Set wsPlanCopy = Worksheets("Plan1")
Set wsPlanPaste = Worksheets("Plan2")

' seleciona a tabela que tera valores copiados
Worksheets(wsPlanCopy.Name).Select
' ativa a celula A1 (por questao de localizacao)
wsPlanCopy.Cells(1, 1).Activate
' seleciona o local e copia o mesmo
Range(Cells(CopiaLinhaIni, CopiaColunaIni), Cells(CopiaLinhaFin, CopiaColunaFin)).Copy

' seleciona a tabela que recebera a colagem
Worksheets(wsPlanPaste.Name).Select
' ativa a celula A1 (por questao de localizacao)
wsPlanPaste.Cells(1, 1).Activate
' seleciona a regiao que recebera a colagem
Range(Cells(CopiaLinhaIni, CopiaColunaIni), Cells(CopiaLinhaFin, CopiaColunaFin)).Select
' efetua a colagem
ActiveSheet.Paste

End Sub

Voce pode estar passando as variaveis de localizacao (CopiaLinhaIni, CopiaLinhaFin, CopiaColunaIni, CopiaColunaFin, ColaLinhaIni, ColaColunaIni) por Parametros assim como tambem um objeto contendo as tabelas de Copia e Colagem.

Espero que voce consiga adequar ao seu caso...

Se for Util... Votaí... 8D

Answer 4

Veja essa função,

Eu gosto de ir por este caminho:

Sub Copia()

    'Posiciona no inicio da lista
    Sheets("Plan1").Select
    Range("A1").Select
    
    'Expande para marcar a lista toda
    Selection.CurrentRegion.Select
    
    'Copia
    Selection.Copy
    
    'Se posiciona na Plan2
    Sheets("Plan2").Select
    Range("A1").Select
    
    'Estas 2 linhas de comando fazem o posicionamento na proxima linha em branco,
    'Caso possa ter celulas em branco, será necessário outro tipo de função para
    'buscar a próxima linha em branco
    Selection.End(xlDown).Select
    Range(Cells(Selection.Row + 1, Selection.Column), Cells(Selection.Row + 1, Selection.Column)).Select
    
    'Cola
    ActiveSheet.Paste
End Sub

att,

Eleriane

---

Nane

Answer 5

"mas o código copia somente uma vez"
Isso acontece porque o código só copia os dados nas células de destino se elas estiverem vazias. Então fica a pergunta: como saber pelo segunda vez quais são as células que devem ser substituídas das que não devem ser substituídas?

Para colar bordas e formato:

Sub Exemplo()
    Const c_sIntervalo As String = "C7:O32"
    Const c_sOrigem As String = "PlanilhaOrigem"
    Const c_sDestino As String = "PlanilhaDestino"
    Dim r As Range
    
    For Each r In Sheets(c_sDestino).Range(c_sIntervalo)
        If r = "" Then
            r.Copy
            Sheets(c_sOrigem).Range(r.Address).PasteSpecial xlPasteValues
            Sheets(c_sOrigem).Range(r.Address).PasteSpecial xlPasteFormats
        End If
    Next r
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br