Ir ao conteúdo
  • Cadastre-se
Leiom

Macro copiar e colar tabelas em abas diferentes

Recommended Posts

Opa pessoal, estou pesquisando sobre esta macro em vários locais e até agora ainda não consegui colocar ela para funcionar (basicamente não achei exatamente o que quero), por isso estou criando este tópico.

Tenho dois arquivos com várias abas iguais dentro deles (uma aba para cada dia do mês) e existe uma tabela em cada aba dessa que quero copiá-las em sequencia em um novo arquivo. 
O detalhe importante que ainda não consegui implementar foi copiar as tabelas a partir da primeira linha vazia da tabela copiada anteriormente, pois as tabelas nem sempre estão 100% preenchidas (ou fazer a macro ler e copiar somente as linhas com valores, mas achei que esse modo seria mais complicado). A macro teria que ser do modo:

- Abrir 'Arquivo1'
- Ler e copiar 'Tabela1.1' em Plan1
- Colar 'Tabela1.1' em 'ArquivoTabelas'
- Mudar de aba e ler e copiar 'Tabela1.2' em Plan2
- Colar 'Tabela1.2' em 'ArquivoTabelas' / começando a partir da primeira linha vazia da Tabela1.1
- Fechar 'Arquivo1'

- Abrir 'Arquivo2'
- Ler e copiar 'Tabela2.1' em Plan1 
- Colar 'Tabela2.1' em 'ArquivoTabelas' / começando a partir da primeira linha vazia da Tabela1.2
- Mudar de aba e ler e copiar 'Tabela2.2' em Plan2
- Colar 'Tabela2.2' em 'ArquivoTabelas' / começando a partir da primeira linha vazia da Tabela2.1
- Fechar 'Arquivo2'

Lembrando que essas tabelas possuem o mesmo tamanho e estão localizadas com início e fim nas mesmas linhas e colunas nas abas.

Tentei explicar bem o que quero e basicamente é isso que eu precisaria, a macro no final seria maior para incrementar com outras abas e arquivos, mas com essa base funcionando já é mais do que o suficiente!

Obrigado!

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pessoal, consegui fazer a colagem a partir da primeira linha vazia da colagem anterior como eu queria. A macro esta em anexo para quem quiser dar uma olhada, está 100% funcional.

Sub Teste()
Workbooks.Open Filename:="C:\Users\leonardo.pontes\Desktop\Nova pasta\Pasta1.xlsx"
Windows("Pasta1.xlsx").Activate
Sheets("Plan1").Range("A1:C6").Copy
Windows("Macro.xlsm").Activate
Range("A1").Select
ActiveSheet.Paste
Windows("Pasta1.xlsx").Activate
Sheets("Plan2").Range("A1:C3").Copy
Windows("Macro.xlsm").Activate
Range("A1").Select
Do
        If ActiveCell <> "" Then
        ActiveCell.Offset(1, 0).Select
        End If
    Loop Until ActiveCell = ""
    ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
Windows("Pasta1.xlsx").Activate
Sheets("Plan3").Range("A1:C6").Copy
Windows("Macro.xlsm").Activate
Range("A1").Select
Do
        If ActiveCell <> "" Then
        ActiveCell.Offset(1, 0).Select
        End If
    Loop Until ActiveCell = ""
    ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    
Windows("Pasta1.xlsx").Activate
ActiveWindow.Close
End Sub


O problema que me resta é que preciso ler 30 abas no mesmo arquivo e do modo que fiz até agora minha macro ficaria muito extensa. Existe algum modo de otimizar a mudança de abas nessa macro (talvez fazer um loop para mudança de abas e dentro dele esse loop que já usei para colar a partir da primeira linha vazia)? Estou chamando o arquivo base e mudando a aba e o arquivo destino "manualmente" por enquanto.

Macro.txt

Compartilhar este post


Link para o post
Compartilhar em outros sites

Obrigado @Wendell Menezes! Vou tentar estudar o exemplo que voce deu nesse post e tentar aplicar, só não sei se vai ser tão rápido pois é um nível de macro que ainda não possuo.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pessoal, passei o dia inteiro hoje tentando mil modificações e modos diferentes, e consegui montar uma macro perfeita pro que eu estava querendo, segue o código para quem interessar.
 

Sub Teste()

Workbooks.Open Filename:="P:\3. Check list_QHH\Nova pasta\Pasta1.xlsx"

    For i = 1 To 30
        dias = CStr(i)
Worksheets(dias).Select
Range("A88:K120").Copy
Windows("Macro.xlsm").Activate
Range("A1").Select

		Do
        	If ActiveCell <> "" Then
        	ActiveCell.Offset(1, 0).Select
        	End If
    	Loop Until ActiveCell = ""
    	ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    	Application.CutCopyMode = False

Windows("Pasta1.xlsx").Activate

    Next i

Windows("Pasta1.xlsx").Activate
ActiveWindow.Close

End Sub

 

Obrigado a todos que ajudaram. Podem fechar o tópico moderadores.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Eu trocaria essa parte:

 

Range("A1").Select

		Do
        	If ActiveCell <> "" Then
        	ActiveCell.Offset(1, 0).Select
        	End If
    	Loop Until ActiveCell = ""
    	ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Por:

 

Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll

 

O método anterior precisa checar linha-a-linha qual é a próxima vazia, ou seja, quanto mais dados forem colados mais tempo vai levar pra macro rodar.

 

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×