none
VBA - Openning multiple Excel files which paths are listed in cells in Excel and run several actions in each RRS feed

  • Question

  • Hi,

    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

    Monday, December 31, 2018 12:49 PM

All replies

  • Something like the following. However, if it is necessary to find the last used cell in column D rather than a fixed number of rows then see the next example.

        Dim myfile As String
        Dim r As Long
        
        For r = 42 To 83
            If Cells(r, 4) <> "" Then   'If not blank
                myfile = Cells(r, 4).Value
                Application.Workbooks.Open Filename:=myfile
            End If
        Next r

    Next Example: Find the last used cell in column D. Note it is dependent on there being no other data below the last cell containing file name.

        Dim myfile As String
        Dim lastR As Long
        Dim r As Long
        
        lastR = Cells(Rows.Count, 4).End(xlUp).Row  'Find last used row in column D
        
        For r = 42 To lastR
            If Cells(r, 4) <> "" Then   'If not blank
                myfile = Cells(r, 4).Value
                Application.Workbooks.Open Filename:=myfile
            End If
        Next r


    Regards, OssieMac


    • Edited by OssieMac Monday, December 31, 2018 8:50 PM
    Monday, December 31, 2018 8:49 PM
  • OssieMac, thank you!!

    It works!

    I moved "Next r" to the end of the routine and all actions are conduted to each file.

    Many thanks and have a great year!

    Tuesday, January 1, 2019 4:56 PM