Notifications
Clear all

Abrir múltiplos arquivos em uma determinada pasta (com e sem indicador de arquivos)

1 Posts
1 Usuários
0 Reactions
1,202 Visualizações
(@prometer)
Posts: 1
New Member
Topic starter
 

Preciso da ajuda de vocês...

 

Preciso de uma macro que encontre um arquivo, em uma determinada pasta, pelo valor de uma célula e, caso não tenha nenhum valor nessa célula, ele abra todos os arquivos dessa determinada pasta, um a um...

 

Por exemplo, se na célula A1 existe uma informação como "05.08.2020", ele vai para a pasta X, e abre primeiro o arquivo com a mesma info (05.08.2020.xlsx), copia um determinado range, cola no arquivo destino, fecha-se o arquivo (05.08.2020.xlsx) e vai para o próximo arquivo, fazendo o mesmo procedimento.

Caso na célula X não exista informação alguma, ele vai para a pasta X, abre o primeiro arquivo da pasta, que pode ser 03.08.2020.xlsx, copia o range determinado, cola no arquivo destino, fecha esse arquivo e passa para o próximo, abrindo assim todos os arquivos dessa pasta.

 

Esse é o código que estou usando, porém estou me perdendo no "Set" por causa do "If":

 

Sub Atualizar_Top_Perdas()
'
' Abrir Base Detalhada BR
'
Dim Currentworkbook As Workbook

ThisWorkbook.Activate' Planilha com informações dos caminhos

PathBR = Range("H4").Value' Caminho do arquivo que vou colar as informações

PathDaily = Range("H27").Value' Caminho da pasta que contém os arquivos de origem, dos quais abrirei um a um, para copiar um range de informações e colar no arquivo do PathBR

PathDailyDate = Range("H30").Value' Caminho do arquivo especifico (arquivo start)

Workbooks.Open Filename:=PathBR
Sheets("Perdas justificativa").Select
Range("N1").Select
Selection.End(xlDown).Select

If ActiveCell.Value <> "" Then
Selection.Copy
Windows("Painel_Controle.xlsm").Activate
Range("I9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Set abr = CreateObject("Scripting.FileSystemObject")

Set here = abr.GetFolder(PathDaily)

For Each FileOpen In here.Files

Set Currentworkbook = Workbooks.Open(Filename:=FileOpen.Path, UpdateLinks:=0)

End If

Aqui eu colocaria o script para copiar as informações do arquivo aberto e colar no arquivo destino...

Next

End Sub

 

Alguém pode me dar uma luz?


Editado pela Moderação. Motivo: Utilize o botão Código (< >) para inserir código VBA ou Fórmulas.

 
Postado : 06/08/2020 5:54 pm
Tags do Tópico