Galera, bom dia
Tenho uma planilha com uma macro feita onde ela precisa fazer uma consulta com filtro avançado em 2 planilhas que estao em um diretório, ("S:\TI\9-Gestao_de_Acesso\ADP - Download do dia\Teste ADP\planilha_de_exe.csv")
e apos isso inserir as informações que preciso em outras 2 planilhas
Na verdade minha dificuldade é apenas fazer uma macro para abrir as planilhas que precisar, apos pegar as informações precisaria de outra macro para fechelas
alguem pode me ajudar?
Desde ja grato
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Abrir planilhas em um diretorio
-
- Acabou de chegar
- Mensagens: 4
- Registrado em: Ter Fev 25, 2020 1:52 pm
Re: Abrir planilhas em um diretorio
Douglas,
Experimente o que se segue abaixo.
Adicione um novo módulo á pasta de trabalho, copie e cole a rotina :
Após isso, chame a rotina (selecionarArquivos) através de teclas de atalho ou de um botão em uma guia qualquer.
Experimente o que se segue abaixo.
Adicione um novo módulo á pasta de trabalho, copie e cole a rotina :
Código: Selecionar todos
Public pastasSelecionadas() As String
Sub selecionarArquivos()
Dim caixaArquivo As Office.FileDialog
Erase pastasSelecionadas
Set caixaArquivo = Application.FileDialog(msoFileDialogFilePicker)
With caixaArquivo
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Arquivos do Excel", "*.xls*, *.csv"
.InitialFileName = ThisWorkbook.Path
.InitialView = msoFileDialogViewList
.Title = "Seleciona o(s) arquivo(s)"
.Show
End With
Application.ScreenUpdating = False
If caixaArquivo.SelectedItems.Count >= 1 Then
ReDim pastasSelecionadas(1 To caixaArquivo.SelectedItems.Count)
For vPasta = 1 To caixaArquivo.SelectedItems.Count
Workbooks.Open caixaArquivo.SelectedItems(vPasta)
pastasSelecionadas(vPasta) = ActiveWorkbook.Name
Next
'=========================================================================
'Insira aqui as rotinas que serão executadas após a abertura dos arquivos
'=========================================================================
Dim nomeArquivo As String
For vPasta1 = 1 To UBound(pastasSelecionadas)
nomeArquivo = ""
nomeArquivo = pastasSelecionadas(vPasta1)
Windows(nomeArquivo).Activate
ActiveWorkbook.Close False
Next
Application.ScreenUpdating = True
nomeArquivo = ""
Set caixaArquivo = Nothing
MsgBox "Atualização realizada com sucesso!", vbInformation, "Atualização"
Else
Application.ScreenUpdating = True
nomeArquivo = ""
Set caixaArquivo = Nothing
MsgBox "Operação cancelada pelo usuário!", vbExclamation, "Atualização"
Exit Sub
End If
End Sub
-
- Acabou de chegar
- Mensagens: 4
- Registrado em: Ter Fev 25, 2020 1:52 pm
Re: Abrir planilhas em um diretorio
Valeu man,
mais uma ajuda, nao manjo de VBA
a macro que fiz que preciso que rode, tem esse código;
Sub aTesteConsultarCRs()
'
' aTesteConsultarCRs Macro
'
'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("I7:L8").Select
Selection.Copy
Range("AD7").Select
ActiveSheet.Paste
Range("AD9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-23]"
Range("A9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Windows("export-grupo-dados.csv").Activate
Windows("Consultar ADP.xlsm").Activate
Range("A6").Select
End Sub
Tentei adicionar onde indicou no codigo e deu erro, consegue me dizer como exatamente coloco esse codigo?
mais uma ajuda, nao manjo de VBA
a macro que fiz que preciso que rode, tem esse código;
Sub aTesteConsultarCRs()
'
' aTesteConsultarCRs Macro
'
'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("I7:L8").Select
Selection.Copy
Range("AD7").Select
ActiveSheet.Paste
Range("AD9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-23]"
Range("A9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Windows("export-grupo-dados.csv").Activate
Windows("Consultar ADP.xlsm").Activate
Range("A6").Select
End Sub
Tentei adicionar onde indicou no codigo e deu erro, consegue me dizer como exatamente coloco esse codigo?
Re: Abrir planilhas em um diretorio
Douglas,
Os arquivos que deseja abrir sempre estarão localizados no mesmo local?
Caso positivo, altere esta linha da rotina :
Para :
Onde caminhoAbsoluto será o caminho completo de onde os arquivos estão, exemplo "S:\TI\9-Gestao_de_Acesso\ADP - Download do dia\Teste ADP\"
Repare também, que a janela para selecionar os arquivos, permite a seleção de múltiplos arquivos, pois possui a instrução AllowMultiSelect = True.
Após abrir os arquivos desejados, em seu bloco de códigos, você deverá definir qual a pasta á ser selecionada para que o mesmo seja executado, veja exemplo :
Antes do seu bloco de códigos, adicione a instrução :
Onde nomeDaPastaDeTrabalho será o nome do arquivo que deseja realizar a operações contidas no seu bloco de códigos.
Após a linha acima, adicione seu bloco de códigos sem o Sub e o End Sub, respectivamente, ficando :
Em um exemplo bem simplificado, a macro final ficaria parecida com o que se segue :
Os arquivos que deseja abrir sempre estarão localizados no mesmo local?
Caso positivo, altere esta linha da rotina :
Código: Selecionar todos
.InitialFileName = ThisWorkbook.Path
Código: Selecionar todos
.InitialFileName = caminhoAbsoluto
Repare também, que a janela para selecionar os arquivos, permite a seleção de múltiplos arquivos, pois possui a instrução AllowMultiSelect = True.
Após abrir os arquivos desejados, em seu bloco de códigos, você deverá definir qual a pasta á ser selecionada para que o mesmo seja executado, veja exemplo :
Antes do seu bloco de códigos, adicione a instrução :
Código: Selecionar todos
Windows(nomeDaPastaDeTrabalho).Activate
Após a linha acima, adicione seu bloco de códigos sem o Sub e o End Sub, respectivamente, ficando :
Código: Selecionar todos
'Ativamos a pasta de trabalho
Windows(nomeDaPastaDeTrabalho).Activate
'Realizamos as operações contidas na sua macro.
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("I7:L8").Select
Selection.Copy
Range("AD7").Select
ActiveSheet.Paste
Range("AD9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-23]"
Range("A9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Windows("export-grupo-dados.csv").Activate
Windows("Consultar ADP.xlsm").Activate
Range("A6").Select
Código: Selecionar todos
Public pastasSelecionadas() As String
Sub selecionarArquivos()
Dim caixaArquivo As Office.FileDialog
Erase pastasSelecionadas
Set caixaArquivo = Application.FileDialog(msoFileDialogFilePicker)
With caixaArquivo
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Arquivos do Excel", "*.xls*, *.csv"
.InitialFileName = "S:\TI\9-Gestao_de_Acesso\ADP - Download do dia\Teste ADP\"
.InitialView = msoFileDialogViewList
.Title = "Selecione o(s) arquivo(s)"
.Show
End With
Application.ScreenUpdating = False
'Aqui abrimos os arquivos selecionados no diretório
If caixaArquivo.SelectedItems.Count >= 1 Then
ReDim pastasSelecionadas(1 To caixaArquivo.SelectedItems.Count)
For vPasta = 1 To caixaArquivo.SelectedItems.Count
Workbooks.Open caixaArquivo.SelectedItems(vPasta)
pastasSelecionadas(vPasta) = ActiveWorkbook.Name
Next
'SUA ROTINA MODIFICADA
'=========================================================================
'Insira aqui as rotinas que serão executadas após a abertura dos arquivos
'Ativamos a pasta de trabalho
Windows(nomeDaPastaDeTrabalho).Activate
'Realizamos as operações contidas na sua macro.
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("I7:L8").Select
Selection.Copy
Range("AD7").Select
ActiveSheet.Paste
Range("AD9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-23]"
Range("A9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Windows("export-grupo-dados.csv").Activate
Windows("Consultar ADP.xlsm").Activate
Range("A6").Select
'=========================================================================
Dim nomeArquivo As String
'Aqui fechamos todos os arquivos abertos no passo anterior
For vPasta1 = 1 To UBound(pastasSelecionadas)
nomeArquivo = ""
nomeArquivo = pastasSelecionadas(vPasta1)
Windows(nomeArquivo).Activate
ActiveWorkbook.Close False
Next
Application.ScreenUpdating = True
nomeArquivo = ""
Set caixaArquivo = Nothing
MsgBox "Atualização realizada com sucesso!", vbInformation, "Atualização"
Else
Application.ScreenUpdating = True
nomeArquivo = ""
Set caixaArquivo = Nothing
MsgBox "Operação cancelada pelo usuário!", vbExclamation, "Atualização"
Exit Sub
End If
End Sub