Abrir múltiplas planilhas em 1 excel

[TT.]

Bom dia pessoal!

Trabalho com manutenção industrial e sou responsável pela abertura de Fichas de Manutenção Preventivas ou Preditivas. O que ocorre é que tenho que abrir mais de 30 planilhas por semana, o que em um ano (que possui 48 semanas) daria em um total de 1440 planilhas por ano. Minha ideia é juntar todas as planilhas da semana em apenas um arquivo excel, é possivel fazer uma importação das planilhas semanais para a "geral", ou algo do tipo, para que facilite esse processo?

Obrigado a todos.

[zinhovba]

Bom dia!!

Quando você diz

brir mais de 30 planilhas

, significa um arquivo com algumas guias?

Então você terá que copiar uma unica guia de cada arquivo?

Todos os arquivos estão no mesmo local (Diretório)?

Att

[TT.]

Bom dia!!

Quando você diz , significa um arquivo com algumas guias?

Então você terá que copiar uma unica guia de cada arquivo?

Todos os arquivos estão no mesmo local (Diretório)?

Att

Não não, são planilhas diferentes, todas com apenas uma guia. E sim, todos os arquivos estão no mesmo diretório.

[zinhovba]

Bom dia!

Como você não falou o nome das guias dos arquivo, quantas e quais colunas etc, etc..

tente adaptar.

    Sub ImportarDados()
'Copiar dados de um Livro para outro
         Dim wsOrigem As Worksheet
         Dim wsDestino As Worksheet

        'Arquivo Destino, abrimos primeiro
        'Ajuste o caminho do mesmo
        Workbooks.Open Filename:="C:\Documents and Settings\oraculo\Meus documentos\Downloads\Master.xls"

         'Arquivos e Abas de Origem e Destino
         Set wsOrigem = Workbooks("Dvisão.xls").Worksheets("Plan1")
         Set wsDestino = Workbooks("Master.xls").Worksheets("Plan5")

            With wsOrigem
                .Range("B2:B500").Copy Destination:=wsDestino.Range("B2")
                .Range("F2:F500").Copy Destination:=wsDestino.Range("K2")
                .Range("J2:J500").Copy Destination:=wsDestino.Range("T2")
            End With

       'Fecha o Arquivo Destino e Salva
        Workbooks("Master.xls").Close SaveChanges:=True

        MsgBox "Introdução de Dados Concluída"
    End Sub