VBA - Abrir multiplos ficheiros Excel (path listados em células) e executar ações

Question

Bom dia,

Preciso de ajuda para fazer o loop das seguintes tarefas em diversos ficheiros excel cujos paths tenho listados numa tabela nas células D42 a D83 da folha "Ficha de funcionario".

Este código VBA funciona para a primeira célula D42, indicando:

Dim myfile As String

myfile = Cells(42, 4).Value

Application.Workbooks.Open Filename:=myfile

Como indico que pretendo executar para os restantes ficheiros de D43 a D83? E se alguma célula estiver vazia (sem path), como digo para ignorar?

Obrigada pela ajuda!! e bom ano !!

O código completo é:

Sub Importar_registos_tempos_individuais()
'
' Importar_registos_tempos_individuais Macro
'

Dim mes As String
mes = Workbooks("Mapa Registo Tempos_total_V6.xlsm").Worksheets("Registo Tempos").Range("F3").Value

Dim ano As String
ano = Workbooks("Mapa Registo Tempos_total_V6.xlsm").Worksheets("Registo Tempos").Range("F2").Value

Sheets("Ficha de funcionario").Select

'Open Excel files

Dim myfile As String

myfile = Cells(42, 4).Value

Application.Workbooks.Open Filename:=myfile

 
  'Unprotect a worksheet

Sheets("Histórico").Select
Sheets("Histórico").Unprotect

'Criar colunas Ano e Mês e Autofilter

    Range("K8").Select
    ActiveCell.FormulaR1C1 = "Ano"
    Range("L8").Select
    ActiveCell.FormulaR1C1 = "Mês"
    Range("K9").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=YEAR(RC[-10])"
    Range("L9").Select
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-11])"
    Range("K9:L9").Select
    Selection.Copy
    Range("A8").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 10).Range("A1:B1").Select
    Range(Selection, Selection.End(xlUp)).Select
    
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$8:$L$19999").AutoFilter Field:=11, Criteria1:=ano
    ActiveSheet.Range("$A$8:$L$19999").AutoFilter Field:=12, Criteria1:=mes

    
'Copy
       

    Range("A8").Select
    ActiveCell.Offset(12, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveCell.Range("A1:J1000").Select
    Selection.Copy


    
'Paste

ThisWorkbook.Activate

Sheets("Registo Tempos").Select
    Range("D10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

  'Save but not save changes

Dim wb As Workbook

  'Loop through each workbook
  For Each wb In Application.Workbooks
    
    'Prevent the workbook that contains the
    'code from being closed
    If wb.Name <> ThisWorkbook.Name Then
      
      'Close the workbook and don't save changes
      wb.Close SaveChanges:=False
    
    End If
  Next wb
  
End Sub

Answer 1

Olá, boa tarde.

Você pode fazer algo do tipo:

Dim i As Long

For i = 42 To 83

    myfile = Cells(i, 4).Value2
    
    If myfile <> vbNullString Then
    
        If Dir(myfile, vbNormal + vbReadOnly + vbHidden) <> vbNullString Then
            
            Application.Workbooks.Open Filename:=myfile
            
            '...
            'Seu código
            '...
            
        End If
    End If
Next i

Atende?

---

Filipe Magno