Loop through each file in folder and perform an action

[Monsieur Roo]

In order to not fall foul of the XY problem I'll describe what I am trying to do rather than bore you with the many ill fated attempts trying to get this to work.

The code below opens a worksheet, copy's out some important information, then pastes it into excel file containing the VBA code, where it is formatted and some descriptions are added. This is then copied to word (so it can be saved as a PDF with a password) I know it's rather convoluted but it works well for what I need it for. But I can only do one file at a time.

What I would like to do is select the folder that contains the "important information" worksheets and loop through each one and perform the code below starting from: Dim LastRow As Integer

I am getting into a mess with referencing the correct workbook, wondering if any one can point me in the right direction and save me from the drudgery of this manual repetitive task.

Sub import_data_from_RC_FULL()
    On Error GoTo ErrorHandler:
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", fileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Dim LastRow As Integer
        LastRow = OpenBook.Sheets("NIMS All").Range("A5").End(xlDown).Row
        OpenBook.Sheets("NIMS All").Range("A5:F" & LastRow).Copy
        ThisWorkbook.Worksheets("RateCard").Range("A5").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        OpenBook.Close False
        Range("A5").Copy
        Range("J2").PasteSpecial Paste:=xlPasteValues
        Sheets("setup").Select

    If Range("D3") = "No Valid Contract Number in 'RateCard' Tab" Then MsgBox "No Ratecard data, Please add and return to Step 2": Exit Sub
    
    Call clearall
    pos = 1: conno = Range("setup!c6"): ypos = 3
    Do While Range("t2000!b" & pos) > 0
        If Trim(Len(Range("t2000!b" & pos))) > 0 Then
            If conno = Range("t2000!b" & pos) Then
                Cells(7, ypos) = Range("t2000!a" & pos)
                Cells(8, ypos) = Range("t2000!c" & pos)
                ypos = ypos + 1
            End If
            pos = pos + 1
        End If
    Loop
        Range("C7:J8").Select
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        End With
            Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
            Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
            Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
            Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
            Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
            Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous

    If Range("D3") = "No Valid Contract Number in 'RateCard' Tab" Then MsgBox "No Ratecard data, Please add and return to Step 2": Exit Sub
    If Len(Trim(Range("c12"))) = 0 Then MsgBox "Please goto step 3 and add 'Contract Live Date' then goto step 4": Exit Sub
Sheets("setup").Select
    pos = 5: ypos = 3: pdfpos = 34:
    
    
    Do While Len(Trim(Range("ratecard!b" & pos))) > 0
        cont = Cells(7, ypos)
        Range("pdf!a30:w30").Copy
        Range("pdf!a" & pdfpos).PasteSpecial
        Range("pdf!D" & pdfpos) = cont
        Range("pdf!k" & pdfpos) = Cells(8, ypos)
        pdfpos = pdfpos + 2
        fpos = pdfpos
        
        Do While Range("ratecard!a" & pos) = cont
            Range("pdf!a" & pdfpos & ":b" & pdfpos).Merge
            Range("pdf!d" & pdfpos & ":l" & pdfpos).Merge
            Range("pdf!n" & pdfpos & ":q" & pdfpos).Merge
            Range("pdf!r" & pdfpos & ":s" & pdfpos).Merge
            Range("pdf!t" & pdfpos & ":u" & pdfpos).Merge
            Range("pdf!v" & pdfpos & ":w" & pdfpos).Merge
            Range("pdf!a" & pdfpos) = Range("ratecard!b" & pos)
            Range("pdf!r" & pdfpos) = Range("ratecard!d" & pos)
            Range("pdf!t" & pdfpos) = Range("ratecard!e" & pos)
            Range("pdf!v" & pdfpos) = Range("ratecard!f" & pos)
            Range("pdf!d" & pdfpos) = "=vlookup(A" & pdfpos & ",'Current Descriptions'!A:C,2,false)"
            Range("pdf!n" & pdfpos) = "=vlookup(A" & pdfpos & ",'Current Descriptions'!A:C,3,false)"
            pdfpos = pdfpos + 1
        
        pos = pos + 1

    Loop
        Sheets("pdf").Select
        Range("R" & fpos & ":W" & pdfpos).Select
        Rows(fpos & ":" & pdfpos).RowHeight = 30
        ActiveSheet.Rows("34").RowHeight = 30


    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    
        Sheets("pdf").Select
        Range("A" & fpos & ":Q" & pdfpos).Select
        Rows(fpos & ":" & pdfpos).RowHeight = 30

    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
   
        Rows(pdfpos).Activate
        ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell
  Sheets("setup").Select
 
        ypos = ypos + 1
       
    Loop
    
        

    Application.ScreenUpdating = False
    
    Call CloseWordDocuments
    
    Dim Obj
    Set Obj = CreateObject("Word.Application")
    
    
    Dim pdftemplate As String
    pdftemplate = ActiveWorkbook.Sheets("Setup").Range("c23").Value
    
    Set NewObj = Obj.documents.Add(Template:=pdftemplate, NewTemplate:=False, DocumentType:=0)
    Sheets("PDF").Select
    ActiveSheet.UsedRange.Copy
    NewObj.Range.Paste
    Application.CutCopyMode = False
    Sheets("Setup").Select
    
    Dim myfilename As String
    myfilename = ActiveWorkbook.Sheets("Setup").Range("c22").Value
    NewObj.Saveas Filename:=myfilename

    Sheets("Setup").Select
    Range("C13").Copy
    
    Obj.Visible = True
    Obj.Activate
    Application.ActivateMicrosoftApp xlMicrosoftWord
    Obj.Visible = True
    Obj.Activate
    Obj.Run "TemplateProject.NewMacros.save"
    
    Call clearrateonRCpage
    Sheets("RateCard").Select
    
    End If
    
    Exit Sub
ErrorHandler:
    MsgBox "An error occured " & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description
    Application.DisplayAlerts = True
    
End Sub