[Ajuda] Importar conteúdo de uma worksheet offline

[jcsr]

Boa noite pessoal!!!

Preciso de uma pequena ajuda. Quero copiar o conteúdo de uma tabela de uma página especifica de uma folha de excel para outra. Queria saber como realizar esta operação sem ter que abrir os ficheiros excel. Consigo executar este processo mas sou obrigado a abrir os ficheiros, retirar a informação que quero e voltar a fechar, o que não é muito vantajoso em termos de tempo pois necessito que o programa abre muitos ficheiros.

[jmaocubo]

Viva...

Penso que o que procuras é uma forma de o excel abrir os ficheiros que tens numa pasta e retire a informação que precisas, feche esse ficheiro e passe para outro até acabarem.

Eu tive esse mesmo problema 👍 e após muita pesquisa na NET e alteração de alguns ponto consegui. Lê bem os comentários no código.

Está a funcionar para uma pasta no c:\ com o nome teste

Option Explicit

Sub Consolidate()
'Open all Excel files in a specific folder and merge data into master
'Moves imported files into another folder
'JBeaucaire (10/5/2009)     (2007 compatible)
Dim fName As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set wbkNew = ThisWorkbook
wbkNew.Activate
Sheets("Folha1").Activate
NR = Range("A" & Rows.Count).End(xlUp).Row + 1

'Path and filename
    OldDir = CurDir     'memorizes the users current working path
    ChDir "C:\Teste"
    fName = Dir("*.xl*") ' neste ponto deves escolher a terminação do ficheiro excel (ex: xls, xlsm, ...)

'Import first active sheet from found file
    Do While Len(fName) > 0
    'First sheet
        Set wbkOld = Workbooks.Open(fName)
        
        wbkNew.Sheets("Folha1").Range("A" & NR).Value = Sheets("C.indirectos").Range("B2").Value ' nome
        wbkNew.Sheets("Folha1").Range("B" & NR).Value = Sheets("C.indirectos").Range("F3").Value ' data
        wbkNew.Sheets("Folha1").Range("C" & NR).Value = Sheets("C.indirectos").Range("G2").Value ' Acave
        wbkNew.Sheets("Folha1").Range("D" & NR).Value = Sheets("C.indirectos").Range("G4").Value ' Aconstr
        wbkNew.Sheets("Folha1").Range("E" & NR).Value = Sheets("C.indirectos").Range("B3").Value ' Prazo
        wbkNew.Sheets("Folha1").Range("F" & NR).Value = Sheets("C.indirectos").Range("B106").Value ' Vvenda
        wbkNew.Sheets("Folha1").Range("G" & NR).Value = Sheets("C.indirectos").Range("I107").Value ' Preço m2/constr.
        wbkNew.Sheets("Folha1").Range("H" & NR).Value = Sheets("C.indirectos").Range("I106").Value ' valor do K
        
        fName = Dir
        wbkOld.Close False
        NR = NR + 1
    Loop
    
'ActiveSheet.Range("A:B").AutoFit
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

ChDir OldDir        'restores users original working path

End Sub

Saliento:

 wbkNew.Sheets("Folha1").Range("A" & NR).Value = Sheets("C.indirectos").Range("B2").Value ' nome

Na folha1 coluna A do livro onde vais importar ele irá buscar a todos os ficheiros na folha C.indirectos célula B2 a informação.

Cumprimentos,

[Guest miguelfreitas]

Boas,

importar de onde para onde ?

[jmaocubo]

Viva Miguel

Penso que é a mim que estás a perguntar o importar de onde para onde.

Passo a explicar melhor o que está no código.

Basicamente uma folha de Excel com este código vai pesquisar na pasta especificada, neste caso c:\teste, e verifica a terminação do Excel: fName = Dir("*.xl*"), neste caso coloquei geral *.xl*, a mim não funciona mas eu apenas necessito do *.xlsm (terminação para livros com permissão para macros) por isso coloco 

fName = Dir("*.xlsm")

A parte que lê os dados, por exemplo:

wbkNew.Sheets("Folha1").Range("A" & NR).Value = Sheets("C.indirectos").Range("B2").Value 

Para o livro (onde coloquei o código) na folha1 na célula A1 (o 1 é definido pela referencia NR que determina isso conforme pré definição do NR) o valor a atribuir é o valor presente na folha C.indirectos na célula B2 de um livro que está na pasta teste (por ordem alfabética). Após conclusão da importação o livro da pasta teste fecha e abre o seguinte que repete os mesmos passos mas o valor irá para a célula A1 +1, ou seja, A2 e assim sucessivamente.

Espero ter explicado da melhor forma.

cumprimentos 

[jcsr]

Boas!!!

É mesmo isso que precisava jmaocubo. Tentei com o controlo ADO mas no final estava sempre com um erro aqui ou ali. Só uma dúvida em relação ao teu script. Pelo que interpretei ele vai abrir todos os ficheiros da directoria escolhida com a extensão pretendida, correcto?

Abraço

[jmaocubo]

Correcto... 😄

cumprimentos,