Results 1 to 1 of 1
  1. #1
    4 Star Lounger
    Join Date
    Apr 2002
    Northern Territory, Australia
    Thanked 0 Times in 0 Posts

    Red face Apply Macro to Multiple workbooks simultaniously

    Disregard Please

    I have a series of 100 spreadsheets, all the same design, different data, all containing a module that I need to amend and then protect again. .This module is secured with a password A friend has developed the code below. It will only work on one spreadsheet, not multiples.

    The other thought is to run a process to delete the current Module and replace it with another on each spreadsheet, all in one process. Any ideas?

    Sub importmodule() 
        Dim MyPath As String, FilesInPath As String 
        Dim MyFiles() As String 
        Dim SourceRcount As Long, FNum As Long 
        Dim mybook As Workbook, BaseWks As Worksheet 
        Dim sourceRange As Range, destrange As Range 
        Dim rnum As Long, CalcMode As Long 
        Dim vbcom As Object 
         ' Change this to the path\folder location of your files.
        MyPath = "filepath" 
         ' Add a slash at the end of the path if needed.
        If Right(MyPath, 1) "\" Then 
            MyPath = MyPath & "\" 
        End If 
         ' If there are no Excel files in the folder, exit.
        FilesInPath = Dir(MyPath & "*.xl*") 
        If FilesInPath = "" Then 
            MsgBox "No files found" 
            Exit Sub 
        End If 
         ' Fill the myFiles array with the list of Excel files
         ' in the search folder.
        FNum = 0 
        Do While FilesInPath "" 
            FNum = FNum + 1 
            ReDim Preserve MyFiles(1 To FNum) 
            MyFiles(FNum) = FilesInPath 
            FilesInPath = Dir() 
        If FNum > 0 Then 
            For FNum = LBound(MyFiles) To UBound(MyFiles) 
                Set mybook = Nothing 
                On Error Resume Next 
                Set mybook = Workbooks.Open(MyPath & MyFiles(FNum)) 
                On Error Goto 0 
                SendKeys "%{F11}", True 
                SendKeys "^r" 
                SendKeys "v" 
                SendKeys "{RIGHT}" 
                SendKeys "123456" 
                SendKeys "{Enter}", False 
            Next FNum 
        End If 
    Last edited by kerryg; 2012-06-21 at 18:23. Reason: Added code tags & formatting

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts