VBA: Copy & Paste Data to template and send it via outlook

[MyNameIsAryy]

Hi guys, I am pretty new to vba and to using a forum, so far I was able to fix everything by searching via google but now I' am stuck. If you need any further details please let me know.

What I want to do: Send an E-mail with a specific excel attachment via Outlook to different colleagues.

The Problem: The file has to be created from a "Master File" and the e-mail addresses change and if a colleague is mentioned more than one time he should only receive 1 e-mail.

What I've accomplished so far:

Option Explicit


Sub Action List()
    Dim strTemplate As String: strTemplate = "mypath.xlsm"
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet


    ' Source/Input Workbook
    Set wbI = ThisWorkbook
    ' Sheet von woher kopiert wird
    Set wsI = ActiveSheet


    ' Source/Output Workbook
    Set wbO = Workbooks.Add(strTemplate)


    With wbO
        ' Set the relevant sheet to where you want to paste
        Set wsO = ActiveSheet


              
        ' copy range to new table
        wsI.Range("A1:I1").Copy
        wsI.Range("A2:I40").Copy


        ' copy A1 : H1 Column width
         wsO.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
        wsO.Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
        
    End With
End Sub

This Code creates the Excel Sheet I want to send to my colleagues. I have to copy it into a template because the template includes a macro and I wasn't able to create a VBA code that copys a modul.

For sending E-mails out to the specific persons I've tried to edit the following code I've found:

Option Explicit


 Public Sub Mails_with_attach()


     Dim avntValues As Variant, avntLines As Variant, avntKeys As Variant
     Dim avntHeader As Variant
     Dim ialngIndex As Long, ialngLine As Long, lngRow As Long
     Dim strFilename As String
     Dim objDictionary As Object
     Dim objOutlook As Object, objMail As Object
     Dim objWorkbook As Workbook


     strFilename = ThisWorkbook.Path & _
         "\Audit_Action_list" & Format(Date, "dd_mm_yyyy") & ".xls"
     If Dir$(strFilename) <> vbNullString Then Call Kill(strFilename)


     With ActiveSheet


         avntValues = .Range(.Cells(3, 1), .Cells(.Rows.Count, 22).End(xlUp)).Value2
         avntHeader = .Range(.Cells(2, 1), .Cells(2, 8)).Value


     End With


     Set objDictionary = CreateObject("Scripting.Dictionary")


     For ialngIndex = LBound(avntValues) To UBound(avntValues)
         If Not objDictionary.Exists(CStr(avntValues(ialngIndex, 6))) Then
             Call objDictionary.Add(CStr(avntValues(ialngIndex, 6)), CStr(ialngIndex))
         Else
             objDictionary(CStr(avntValues(ialngIndex, 6))) = _
                 objDictionary(CStr(avntValues(ialngIndex, 6))) & ";" & CStr(ialngIndex)
         End If
     Next


     avntKeys = objDictionary.Keys


     Set objOutlook = CreateObject("Outlook.Application")


     For ialngIndex = LBound(avntKeys) To UBound(avntKeys)


         avntLines = Split(objDictionary(avntKeys(ialngIndex)), ";")


         Set objWorkbook = Workbooks.Add(xlWBATWorksheet)


         With objWorkbook.Worksheets(1)


             With .Range(.Cells(1, 1), .Cells(1, 8))
                 .Value = avntHeader
                 .Font.Bold = True
                 .HorizontalAlignment = xlCenter
             End With


             lngRow = 2


             For ialngLine = LBound(avntLines) To UBound(avntLines)


                 .Range(.Cells(lngRow, 1), .Cells(lngRow, 8)).Value = Array( _
                     avntValues(CLng(avntLines(ialngLine)), 1), _
                     avntValues(CLng(avntLines(ialngLine)), 2), _
                     avntValues(CLng(avntLines(ialngLine)), 3), _
                     avntValues(CLng(avntLines(ialngLine)), 4), _
                     avntValues(CLng(avntLines(ialngLine)), 5), _
                     avntValues(CLng(avntLines(ialngLine)), 6), _
                     avntValues(CLng(avntLines(ialngLine)), 7))


                 lngRow = lngRow + 1


             Next


             .Columns.AutoFit


         End With


         objWorkbook.Close savechanges:=True, Filename:=strFilename


         Set objMail = objOutlook.CreateItem(0)


         With objMail


             .To = avntValues(CLng(avntLines(0)), 22)
             .Subject = "Abverfolgung" & Cells(3, 2)
             .Body = "Ausfüllen etc....body Text muss ich noch schreiben"
             .Attachments.Add strFilename


              .Display 'test
 '            .Send


         End With


         Kill strFilename


     Next


     Set objWorkbook = Nothing
     Set objDictionary = Nothing
     Set objMail = Nothing
     Set objOutlook = Nothing


 End Sub

This code right now looks through my sheet and sends (displays) to the intended persons but only uses data from the "Master file" and therefore does not include the modul with the code from the template + its formatting.

Is it somehow possible to combine these codes? I've tried to remove the copying from the second Code and just add the new Template as an attachment but couldn't do it.

Any help is really appreciated!

BR
Aryy

 

[MyNameIsAryy]

I am also open for any other ideas on how to automate this process...if there are any :/.