CODEWITHSUNDEEP
excelvbavbe
cdfj
cdfj

Reputation: 165

Macro to add code to individual Excel worksheet

The macro below exports data to separate files (a single table / single worksheet to one workbook).

I am attempting to add code to the worksheet to highlight updates made by users to the values in the exported worksheet.

I can add the code to the workbook, as illustrated, where it does not work.

Sub CopyTablesToNewFiles_DeleteConnections_Worksheet_Change2()
    Dim wbSource, wbNew As Workbook
    Dim ws As Worksheet, wsNew As Worksheet
    Dim savePath, currentDate, wsName, Filename As String

    currentDate = Format(Date, "YYYYMMDD")
    Set wbSource = ThisWorkbook

    For Each ws In wbSource.Worksheets
        ws.Copy
        Set wbNew = ActiveWorkbook

            'This gives a Type MisMatch error
            'wbNew.VBProject.VBComponents.Item(wsNew).CodeModule.AddFromString ( _

            'Copies code to ThisWorkbook, need to copy to new worksheet wsNew
            wbNew.VBProject.VBComponents.Item("ThisWorkbook").CodeModule.AddFromString ( _
                "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf _
                & "Target.Interior.ColorIndex = 27" & vbCrLf _
                & "End Sub")
            
        savePath = "C:\path\Test\"
        wbNew.SaveAs Filename:=savePath & currentDate & "_" & ws.Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
        wbNew.Close
    Next ws

    'wbSource.Close
End Sub

Upvotes: 1

Views: 59

Answers (1)

taller
taller

Reputation: 18943

  • Using Item(<SheetCodeName>) to get the sheet's VBComponent
wbNew.VBProject.VBComponents.Item(wbNew.Sheets(1).CodeName).CodeModule.AddFromString ( _
            "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf _
            & "Target.Interior.ColorIndex = 27" & vbCrLf _
            & "End Sub")

Upvotes: 3

Related Questions