+ Reply to Thread
Results 1 to 6 of 6

Macro for Protecting Sheet (with same name) on multiple files at once?

Hybrid View

  1. #1
    Registered User
    Join Date
    08-10-2011
    Location
    Phoenix, AZ
    MS-Off Ver
    Excel 2007
    Posts
    16

    Re: Macro for Protecting Sheet (with same name) on multiple files at once?

    Right, I guess I am looking for a code that will open all the files I select one at a time, protect sheet 1 (Clients), close the file, then move to the next one.
    I have a "Combine" macro that does something similar to this... it allows me to select multiple files, it opens them one at a time, copies and pastes data from them into a "Master" sheet and then closes them.
    This is that code:
    Private Declare Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
    Sub ChDirNet(szPath As String)
        SetCurrentDirectoryA szPath
    End Sub
    
    Sub Combine_Workbooks_Select_Files()
        Dim MyPath 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 SaveDriveDir As String
        Dim FName As Variant
    
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        SaveDriveDir = CurDir
        ChDirNet "C:\Documents and Settings"
    
        FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                                            MultiSelect:=True)
        If IsArray(FName) Then
            Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
            rnum = 1
            For Fnum = LBound(FName) To UBound(FName)
                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(FName(Fnum))
                On Error GoTo 0
                If Not mybook Is Nothing Then
                    On Error Resume Next
                    With mybook.Worksheets(1)
                        Set sourceRange = .Range("A2:AK250")
                    End With
                    If Err.Number > 0 Then
                        Err.Clear
                        Set sourceRange = Nothing
                    Else
            If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                            Set sourceRange = Nothing
                        End If
                    End If
                    On Error GoTo 0
    
                    If Not sourceRange Is Nothing Then
    
                        SourceRcount = sourceRange.Rows.Count
    
                        If rnum + SourceRcount >= BaseWks.Rows.Count Then
                            MsgBox "Not enough rows in the sheet. "
                            BaseWks.Columns.AutoFit
                            mybook.Close savechanges:=False
                            GoTo ExitTheSub
                        Else
                            Set destrange = BaseWks.Range("A" & rnum)
                            With sourceRange
                                Set destrange = destrange. _
                                                Resize(.Rows.Count, .Columns.Count)
                            End With
                            destrange.Value = sourceRange.Value
    
                            rnum = rnum + SourceRcount
                        End If
                    End If
                    mybook.Close savechanges:=False
                End If
            Next Fnum
            BaseWks.Columns.AutoFit
        End If
    ExitTheSub:
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
        ChDirNet SaveDriveDir
    End Sub
    I guess I was hoping for a code that could do something similar for locking multiple files... It may not be possible, but I thought I would check with the experts.
    Last edited by brolsen; 07-19-2014 at 02:46 PM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Macro to delete first working sheet in multiple files
    By Kaapoff in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 05-06-2014, 05:59 AM
  2. Macro to delimit and compile multiple files to one sheet:
    By llunde3 in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 08-15-2013, 10:34 AM
  3. Macro involving multiple sheet and files
    By dguenther in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-15-2011, 08:41 AM
  4. Macro for updating a sheet in multiple files
    By jijy in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 06-26-2006, 01:21 PM
  5. Protecting Multiple Sheet
    By Conditional Formatting in forum Excel Formulas & Functions
    Replies: 2
    Last Post: 10-03-2005, 05:51 AM

Tags for this Thread

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1