[Resolvido] Excel - Copiar e Colar de diversas planilhas

Sub ReplicaDados()

Dim i As Long

  For i = 2 To Sheets.Count

   Cells(Rows.Count, 3).End(3)(2).Resize(, 8) = _

    Application.Transpose(Sheets(i).[E11:E18])

  Next i

End Sub

osvaldomp disse:

Olá, Gabriel.
Se você quiser experimentar esta solução via macro, instale o código abaixo em um módulo comum, assim:

1. copie o código daqui
2. a partir da planilha em que estão os dados tecle 'Alt+F11' para acessar o editor de VBA
3. no menu do editor >> Inserir >> Módulo
4. cole o código na janela em branco que vai se abrir
5. feito! 'Alt+Q' para retornar para a planilha e testar

para rodar o código (mantenha a planilha "Plan1" como a planilha ativa):
6. tecle 'Alt+F8' >> selecione a macro correspondente >> Executar, ou insira um botão na planilha e vincule-o à macro ou vincule-a a um atalho de teclado (Alt+F8 > Opções).

Sub ReplicaDados()

Dim i As Long

  For i = 2 To Sheets.Count

   Cells(Rows.Count, 3).End(3)(2).Resize(, 8) = _

    Application.Transpose(Sheets(i).[E11:E18])

  Next i

End Sub

osvaldomp disse:

Olá, Gabriel.
Você poderia disponibilizar o arquivo com o código instalado ?

osvaldomp disse:

Gabriel, o que causa o problema são as suas células mescladas na planilha "Plan1". No seu primeiro arquivo a linha 4 está preenchida e sem células mescladas. Teste o código naquele arquivo e veja o resultado. Já no seu segundo arquivo a linha 4 está vazia e você caiu na armadilha das células mescladas nas linhas 2 e 3, por isso o código não funciona corretamente. Selecione as células mescladas e desfaça a mesclagem, depois teste o código.

Sugestão - nunca mescle células, pois células mescladas podem provocar erros em macros e em fórmulas.

Sub teste()

For Each vplan In Sheets

If vplan.Name <> "Plan1" Then

    Sheets(1.4).Select

    Range("E11&quot.Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("Plan1&quot.Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

    False, Transpose:=True

    ActiveCell.Offset(1, 0).Range("A1&quot.Select

    End If

 

    Next

    End Sub

gabrielmaia.gm disse:

...não entendi nada mas fiz o que pediu
DEU CERTO