Notifications

Clear all

INVIAR DADOS PARA OUTRO ARQUIVO VBA

2024 - VBA & Macros

Post Recente por Fernando Fernandes 8 anos atrás

7 Posts

4 Usuários

0 Reactions

1,274 Visualizações

RSS

emersoccb

(@emersoccb)

Posts: 4

New Member

Topic starter

Pessoal boa tarde!

Coloquei a macro abaixo pra copiar os atendimentos de um arquivo para outro,

Porem sempre cola no mesmo lugar sobrepondo as informações anteriores,

como faço para sempre colar na proxima linha vazia.

segue macro:

Sub Copiar_Dados()
        Dim wsOrigem As Worksheet
        Dim wsDestino As Worksheet
        
        'Arquivo Destino, abrimos primeiro
        'Ajuste o caminho do mesmo
       linha = Sheets("Atendimentos").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row + 1
        
        'Arquivos e Abas de Origem e Destino
        Set wsOrigem = Worksheets("Atendimentos")
        Set wsDestino = Workbooks("Ind.Supervisor.xlsm").Worksheets("Atendimentos")
          
     
            With wsOrigem
                .Range("B10:B44").Copy Destination:=wsDestino.Range("B10")
                .Range("C10:C44").Copy Destination:=wsDestino.Range("C10")
                .Range("D10:D44").Copy Destination:=wsDestino.Range("D10")
                .Range("E10:E44").Copy Destination:=wsDestino.Range("E10")
                .Range("F10:F44").Copy Destination:=wsDestino.Range("F10")
                .Range("G10:G44").Copy Destination:=wsDestino.Range("G10")
                
                  ContLinha = ContLinha + 1
            End With
      
      'Fecha o Arquivo Destino e Salva
        Workbooks("Ind.Supervisor.xlsm").Save
        
        MsgBox "Envio de Dados Concluído"
    End Sub

Postado : 18/03/2017 12:00 pm

Syrax

(@syrax)

Posts: 160

Estimable Member

Você precisa ativar o destino primeiro, senão o excel não entende para onde deve colar

exemplo

Sub Copiar_Dados()
Dim i, a
Set i = Workbooks("Pasta1.xlsm").Worksheets("Atendimentos") ' troque Pasta1.xlsm pelo nome da sua planilha
Workbooks.Open ("Ind.Supervisor.xlsm")
Set a = Workbooks("Ind.Supervisor.xlsm").Worksheets("Atendimentos")
Workbooks("Ind.Supervisor.xlsm").Activate

With i
.Range("B10:B44").Copy a.Range("B10")
.Range("C10:C44").Copy a.Range("C10")
.Range("D10:D44").Copy a.Range("D10")
.Range("E10:E44").Copy a.Range("E10")
.Range("F10:F44").Copy a.Range("F10")
.Range("G10:G44").Copy a.Range("G10")
End With

Workbooks("Ind.Supervisor.xlsm").Save
MsgBox "Envio de Dados Concluído"
End Sub

se isso te ajudou, clique no "joinha" ao lado de citar

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

Postado : 18/03/2017 4:44 pm

emersoccb

(@emersoccb)

Posts: 4

New Member

Topic starter

Mas ele ainda continua sobrepondo a informação anterior.
eu queria que ele envie os dados para a próxima linha vazia.

Postado : 18/03/2017 7:25 pm

brunoxro

(@brunoxro)

Posts: 698

Honorable Member

Boa noite emersoccb,

Teste:

Sub Copiar_Dados()

    Dim wsOrigem        As Worksheet
    Dim wsDestino       As Worksheet
    
    Dim i               As Double
    'Pega a última linha da Planilha de Destino
    i = Workbooks("Ind.Supervisor.xlsm").Worksheets("Atendimentos").Cells(Rows.Count, "B").End(xlUp).Row + 1
    
    'Arquivos e Abas de Origem e Destino
    Set wsOrigem = Worksheets("Atendimentos")
    Set wsDestino = Workbooks("Ind.Supervisor.xlsm").Worksheets("Atendimentos")
    
    With wsOrigem
        'Noque que você deve especificar qual a primeira linha vazia, para não copiar em cima _
        dos outros valores
        .Range("B10:B44").Copy Destination:=wsDestino.Range("B" & i)
        .Range("C10:C44").Copy Destination:=wsDestino.Range("C" & i)
        .Range("D10:D44").Copy Destination:=wsDestino.Range("D" & i)
        .Range("E10:E44").Copy Destination:=wsDestino.Range("E" & i)
        .Range("F10:F44").Copy Destination:=wsDestino.Range("F" & i)
        .Range("G10:G44").Copy Destination:=wsDestino.Range("G" & i)
        

    End With
    
    'Fecha o Arquivo Destino e Salva
    Workbooks("Ind.Supervisor.xlsm").Save
    
    MsgBox "Envio de Dados Concluído"
    
End Sub

O seu código sempre vai jogar os valores na linha 10 da planilha de destino, por isso tive que criar uma variável para saber qual o valor da última linha vazia da planilha de destino.

Esse código está completo? Porque vi algumas linhas 'inúteis' , como a que pega 'ContLinha' e a 'linha'.

OBS: Caso não funcione, disponibilize um arquivo de exemplo. Assim fica mais fácil entender e ajudar.

att,

Postado : 18/03/2017 7:41 pm

Syrax

(@syrax)

Posts: 160

Estimable Member

fiz a solução usando uma função para descobrir qual é a última linha de cada coluna

Sub Copiar_Dados()
Dim i, a
Set i = Worksheets("Atendimentos")
Workbooks.Open ("Ind.Supervisor.xlsm")
Set a = Workbooks("Ind.Supervisor.xlsm").Worksheets("Atendimentos")
Workbooks("Ind.Supervisor.xlsm").Activate

With i
.Range("B10:B44").Copy a.Range("B" & linha("Ind.Supervisor.xlsm", "Atendimentos", "B"))
.Range("C10:C44").Copy a.Range("C" & linha("Ind.Supervisor.xlsm", "Atendimentos", "C"))
.Range("D10:D44").Copy a.Range("D" & linha("Ind.Supervisor.xlsm", "Atendimentos", "D"))
.Range("E10:E44").Copy a.Range("E" & linha("Ind.Supervisor.xlsm", "Atendimentos", "E"))
.Range("F10:F44").Copy a.Range("F" & linha("Ind.Supervisor.xlsm", "Atendimentos", "F"))
.Range("G10:G44").Copy a.Range("G" & linha("Ind.Supervisor.xlsm", "Atendimentos", "G"))
End With

Workbooks("Ind.Supervisor.xlsm").Save
MsgBox "Envio de Dados Concluído"

End Sub


Function linha(a, b, c)
linha = Workbooks(a).Worksheets(b).Range(c & "1048576").End(xlUp).Row + 1
End Function

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

Postado : 18/03/2017 8:47 pm