none
Macro para copiar dados de uma coluna de várias planilhas de um mesmo arquivo de trabalho. RRS feed

  • Pergunta

  • Gostaria de uma ajuda se possível!

    No meu caso, possuo um arquivo .xls com 500 planilhas (1;1.1;1.2-...-1.500), cada planilha possui uma coluna que vai de A1 até A518.

    Tenho que montar uma matriz com essas colunas, por isso, gostaria de aplicar um script que viabilizasse postar as colunas de cada planilha uma do lado da outra em uma única planilha.

    Muito Obrigado!
    • Movido Enderson Valente sábado, 1 de dezembro de 2012 13:37 forum adequado. (De:Grupos de Usuários)
    • Movido Hezequias VasconcelosModerator sábado, 1 de dezembro de 2012 14:31 Questão relacionada ao produto VBA (De:Office - Geral)
    quinta-feira, 29 de novembro de 2012 19:15

Respostas

  • Sub Exemplo()
        Dim ws As Worksheet
        Dim wsResumo As Worksheet
        Sheets.Add Before:=Sheets(1)
        Set wsResumo = Sheets(1)
        For Each ws In Sheets
            With ws
                If .Index > 1 Then
                    .Range("A1:A518").Copy
                    wsResumo.Cells(2, .Index).PasteSpecial xlPasteValues
                    wsResumo.Cells(1, .Index) = .Name
                End If
            End With
        Next ws
        wsResumo.Columns(1).Delete
    End Sub


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

    sábado, 1 de dezembro de 2012 16:02
    Moderador

Todas as Respostas

  • Olá Bikenart, bom dia.

    Estou migrando seu post para o fórum especializado em VBA.


    Hezequias Vasconcelos

    sábado, 1 de dezembro de 2012 14:30
    Moderador
  • Sub Exemplo()
        Dim ws As Worksheet
        Dim wsResumo As Worksheet
        Sheets.Add Before:=Sheets(1)
        Set wsResumo = Sheets(1)
        For Each ws In Sheets
            With ws
                If .Index > 1 Then
                    .Range("A1:A518").Copy
                    wsResumo.Cells(2, .Index).PasteSpecial xlPasteValues
                    wsResumo.Cells(1, .Index) = .Name
                End If
            End With
        Next ws
        wsResumo.Columns(1).Delete
    End Sub


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

    sábado, 1 de dezembro de 2012 16:02
    Moderador