No announcement yet.

VBA - Openning multiple Excel files which paths are listed in cells in Excel

  • Filter
  • Time
  • Show
Clear All
new posts

  • VBA - Openning multiple Excel files which paths are listed in cells in Excel


    I am trying to loop the following tasks in multiple Excel fies, which paths are listed in cells D42 a D83 in worksheet "Ficha de funcionario".

    This vba code works for the first cell D42:

     Dim myfile As String  myfile = Cells(42, 4).Value  Application.Workbooks.Open Filename:=myfile

    How can I make this code usefull for the remaining paths disclosed in cells D43 to D83? If a cell is blank (i.e. for example D48 is blank) , how can I make vba ignore that cell and run the actions for the remaining cells?

    Thank you for the help and have a happy new year!

    This is the full code:
    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

  • #2

    Sub OpenMyFiles()
    Dim Rng As Range
    Dim Subrng As Range
    Worksheets("Ficha de funcionario").Select
    Set Rng = Range("D42:D83")
    For Each Subrng In Rng
        If Subrng <> "" Then Application.Workbooks.Open Filename:=Subrng
    Next Subrng
    End Sub