Move the Excel VBA Code from One Workbook to Another.

Hi All,

Recently, I wanted to move VBA Code from one workbook to another. I didn't have any idea. So my teammate did me a favor and got me the following code. So I thought that it is good to share it with the outside world. Moreover, it also moves the code with the Forms as well.

The function expects two parameters,

sourceBook: the workbook where we have to copy the code from
destBook : the workbook where the code has to be copied to

Sub MoveVBACode(sourceBook As Workbook, destBook As Workbook)

    Dim sourceVbComp As VBIDE.VBComponents
    Dim destVbComp As VBIDE.VBComponents


    Dim vbComp As VBComponent


    'To check the code is protected or not
    If sourceBook.VBProject.Protection = vbext_pp_locked Then
        MsgBox "Can't copy code because Source project code is password protected", vbInformation
        Exit Sub
    End If

    Set sourceVbComp = sourceBook.VBProject.VBComponents
    Set destVbComp = destBook.VBProject.VBComponents

    'To copy the modules from source to destination
    For Each vbComp In sourceVbComp
        If vbComp.Type = vbext_ct_Document Then
            CopyModule vbComp, destVbComp, ""
        ElseIf vbComp.Type = vbext_ct_StdModule Then
            CopyModule vbComp, destVbComp, ".bas"
        ElseIf vbComp.Type = vbext_ct_MSForm Then
            CopyModule vbComp, destVbComp, ".frm"
        ElseIf vbComp.Type = vbext_ct_ClassModule Then
            CopyModule vbComp, destVbComp, ".cls"
        End If
    Next

End Sub

Function CopyModule(sourceVbComp As VBIDE.VBComponent, _
                    destVbComp As VBIDE.VBComponents, _
                    extn As String)
    
Dim fName As String
Dim vbComp As VBIDE.VBComponent
Dim destCodeMod As VBIDE.CodeModule
Dim codeText As String
Dim destCodeModule As Variant
Dim TempVBComp As Variant

Const filePath As String = "C:\"
Const xportPath As String = "C:\Temp\"
    
    fName = xportPath & sourceVbComp.Name & extn
    
    sourceVbComp.Export fName
    
    If sourceVbComp.Type = vbext_ct_Document Then
    'To copy the code form ThisWorkbook and sheets
        
        'To get the code module in the destination file
        For Each vbComp In destVbComp
            If vbComp.Type = vbext_ct_Document And vbComp.Name = sourceVbComp.Name Then
                Set destCodeModule = vbComp.CodeModule
                Exit For
            End If
        Next
        
        'To update the code from source to destination
        If Not destCodeModule = "" Then
            Set TempVBComp = destVbComp.Import(fName)
            With destCodeModule
                If TempVBComp.CodeModule.CountOfLines > 0 Then
                     codeText = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
                    .InsertLines 1, codeText
                End If
            End With
              destVbComp.Remove TempVBComp
        End If
        
    Else ' For modules ,forms and classes
        destVbComp.Import fName
    End If
        
    'To kill the exported file
    Kill fName

End Function

Thanks,
Vikas

Move all worksheets from a workbook to another

Hi,

Ever moved all the worksheets from a workbook to another. I did it previously, so thought to share the code with you all.

Public Sub CopyWorksheets(sourceBook As Workbook, destBook As Workbook)
   
    Dim shtCounter As Integer
    Dim wkSheet As Worksheet
    
    'remove all the sheets from Destination workbook except one.
    'the last worksheet will be deleted once we have copied the worksheets
    
    For shtCounter = destBook.Worksheets.Count To 2 Step -1
        Set wkSheet = destBook.Worksheets(shtCounter)
        Application.DisplayAlerts = False
        wkSheet.Delete
        Application.DisplayAlerts = True
    Next shtCounter
    
    'rename the sheet1 so that we can assure there is no duplicity
    
    Set wkSheet = Worksheets(1)
    
    wkSheet.Name = "123111xSheet111789" 'giving some arbit name so that we can
                                        ' assure that the sheets we are trying
                                        'copy doesn't have the same name as the worksheet's name.
    
    'copy sheets to destWKB
    
    sourceBook.Worksheets.Copy after:=destBook.Worksheets(1)
    
    
    
    Application.DisplayAlerts = False
    wkSheet.Delete
    Application.DisplayAlerts = True
End Sub

HTH,
Vikas Bhandari

Excel - Break External Links

Hi All,

Please find below the code for Breaking the external links from a Workbook.

Public Sub BreakLinks()
    Dim aLinks As Variant
    Dim i As Integer
    Dim sht As Worksheet
    
    aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(aLinks) Then
        For i = 1 To UBound(aLinks)
            ActiveWorkbook.BreakLink Name:=aLinks(i), Type:=xlExcelLinks
        Next i
    End If
End Sub

Hope this helps.

Thanks,
Vikas

Allow User to Enter Data in a Protected Sheet

Hi All,

We know that we can protect a worksheet so that user should not able to touch any of values in cell. You can protect the sheet by going to Review Tab --> Protect Sheet option. The option is shown in the following screenshot:



This is easy. But what if we want to allow user to enter data in some of the cells. Or if we want to open few of the cells to the user where he/she can enter his/her inputs.

Protection on a worksheet works only for those cells which are Locked. By default, every cell in a worksheet is locked so when a user protects a worksheet, all of the cells are locked by default. Vice versa, if a cell is not locked then user can edit the data even if the worksheet is protected. So to allow few of the cells to be unlocked(so that these can remain unprotected), we first need to remove the locked option from the cells. Following are the steps given to achieve this :

--> Select the cell which you want to unlock
--> Right click on that cell and click on Format Cells. It is displayed in the following screenshot :



--> Go to the protection Tab, and uncheck the "Locked" option. See the following screenshot:



If you keep this option unchecked for a cell/range, the cell/range cannot be protected. So if you want to keep few of cells open for user in a protected sheet, you can use the above mentioned procedure.

Hope this helps :)

Thanks,
Vikas