Copiar dados filtrados da pasta de trabalho fechada com base no intervalo nomeado

0

Primeira abordagem aqui.

Gostaria de saber se você pode me ajudar com o seguinte problema: Eu encontrei este código e preciso ajustá-lo às minhas necessidades, mas não sei como fazer:

Existe um arquivo (Closed.xlsx) que é exportado diariamente de um servidor, com tamanho variável a cada dia (> 100.000 linhas). Eu preciso filtrar e copiar dados específicos (cols 1,3,8,24,27) desse arquivo com base em critérios (intervalo chamado "TECH", que existe informação em col 8 ). TECH tem os nomes de uma equipe técnica específica (John, Richard, Charles, ...). Os dados filtrados serão colados em Open.xlsm Sheet "Report" (mesma pasta) Eu trabalho com o Excel 2013/2016

Meu objetivo é: abrir a pasta de trabalho "Open.xlsm" Folha "Relatório" e atualizar automaticamente os dados filtrados

Option Explicit 

 'you can extract data from a closed file by using an
 'XLM macro. Credit for this technique goes to John
 'Walkenback > http://j-walk.com/ss/excel/tips/tip82.htm

Sub GetDataDemo() 

    Dim FilePath$, Row&, Column&, Address$ 


     'change constants & FilePath below to suit
     '***************************************
    Const FileName$ = "Closed.xlsx" 
    Const SheetName$ = "DataList" 
    Const NumRows& = 100000 'Need to configure range from A1 to last row non blank to get range exact size
    Const NumColumns& = 28 'Or setup only cols 1,3,8,24,27
    FilePath = ActiveWorkbook.Path & "\" 
     '***************************************


    DoEvents 
    Application.ScreenUpdating = False 
    If Dir(FilePath & FileName) = Empty Then 
        MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist" 
        Exit Sub 
    End If 
    For Row = 1 To NumRows 
        For Column = 1 To NumColumns 
            Address = Cells(Row, Column).Address 'How to setup named range 
            Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address) 
            Columns.AutoFit 
        Next Column 
    Next Row 
    ActiveWindow.DisplayZeros = False 
End Sub 




Private Function GetData(Path, File, Sheet, Address) 
    Dim Data$ 
    Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
    Range(Address).Range("A1").Address(, , xlR1C1) 
    GetData = ExecuteExcel4Macro(Data) 
End Function

Muito obrigado pela sua atenção. JT

    
por Jonas Tiger 15.12.2017 / 16:13

0 respostas