Join two codes together

[MAButler]

I need to join this code

Option Explicit

Sub Test_mod()
Dim myrange, ar, mainsh As Object, shtActive As Worksheet
Dim RngCol As Range
Dim lLoop As Long
Dim lastR As Long
Dim sh As Worksheet

    
Application.ScreenUpdating = False
Workbooks.Open ("C:\Documents and Settings\ButlerM2\Desktop\Address.xls")
Workbooks.Open ("C:\Documents and Settings\ButlerM2\Desktop\Week.xls")



lastR = Cells(Rows.Count, 1).End(xlUp).Row

For lLoop = 2 To lastR
    Cells(lLoop, 10) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,2,0)"
    Cells(lLoop, 11) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,3,0)"
    Cells(lLoop, 12) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,4,0)"
    Cells(lLoop, 13) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,5,0)"
    Cells(lLoop, 14) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,6,0)"
    Cells(lLoop, 15) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,7,0)"
    Cells(lLoop, 16) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,8,0)"
    Cells(lLoop, 17) = "=VLOOKUP(" & Cells(lLoop, 9) & ",[ADDRESS.xls]Contacts!$C:$K,9,0)"
Next lLoop
 
 
    Set shtActive = Sheets("Weekly Data")
    With Workbooks.Add.Worksheets(1)
        shtActive.Cells.Copy
        .Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        Do While .Parent.Sheets.Count > 1
            .Parent.Sheets(.Parent.Sheets.Count).Delete
        Loop
        
    End With
Windows("Address.xls").Close
Windows("Week.xls").Close
    
    Application.DisplayAlerts = True
    
Set mainsh = ActiveSheet
    
With mainsh.Range([A1], Cells(Rows.Count, "a").End(xlUp))
    .Offset(, 8).Cut: .Offset(, 1).Insert shift:=xlToRight
    .Offset(, 6).Resize(, 3).Cut .Offset(, 4).Resize(, 3)
    .Offset(, 9).Resize(, 8).Cut .Offset(, 6).Resize(, 8)
    .Resize(, 7).Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), Replace:=True, SummaryBelowData:=True
End With

Set myrange = Range([a2], Cells(Rows.Count, "a").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)

For Each ar In myrange.Areas
    Sheets.Add after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Pictures.Insert ("C:\Documents and Settings\ButlerM2\Desktop\DVLA Logo.png")
        .[a16:f16].Merge: .[a16] = "Non Payment of Account"
        .[a17:f17].Merge: .[a17] = "DVLA Automated First Registration & Licensing (AFRL) System"
        .[F2] = "DVLA Swansea"
        .[F3] = "ARU C1 West"
        .[F4] = "Something Road"
        .[F5] = "Swansea"
        .[F6] = "Postcode"
        .[c8:f9].Merge: .[C8] = "We have the following contact details for your Company"
        .[C10] = "Name"
        .[C11] = "Phone"
        .[C12] = "Email"
        .[c13:f14].Merge: .[C13] = "If they are incorrect please call or Email us"
        .[a22:f22] = mainsh.[A1].Resize(, 14).Value
        .[a16:f17].HorizontalAlignment = xlCenter
        .[a22:f22].HorizontalAlignment = xlCenter
        .[a1:a15].HorizontalAlignment = xlLeft
        .[f1:f19].HorizontalAlignment = xlRight
        
        .[a1:f22].RowHeight = 15
        .Name = ar(1).Offset(, 1)
        With .Range(.[a23], .[a23].Offset(ar.Rows.Count))
            .Resize(, 14).Value = ar.Resize(ar.Rows.Count + 1, 14).Value
            .Offset(, 1).NumberFormat = "0"
            .Offset(, 2).NumberFormat = "0.00"
            .Offset(, 3).Resize(, 3).NumberFormat = "dd/mm/yyyy"
            .ColumnWidth = 30
            .Offset(, 1).Resize(, 2).ColumnWidth = 13
            .Offset(, 3).Resize(, 3).ColumnWidth = 12
            .RowHeight = 30
            .HorizontalAlignment = xlLeft
            .Offset(, 1).Resize(, 2).HorizontalAlignment = xlRight
            .Offset(, 3).Resize(, 2).HorizontalAlignment = xlCenter
            
        End With
            With .UsedRange
                .Font.Name = "Times New Roman"
                .Font.FontStyle = "Regular"
                .Font.Size = 12
            End With
                With .PageSetup
                    .LeftMargin = Application.InchesToPoints(0.19)
                    .RightMargin = Application.InchesToPoints(0.19)
                    .TopMargin = Application.InchesToPoints(0.9)
                    .BottomMargin = Application.InchesToPoints(0.9)
                    .HeaderMargin = Application.InchesToPoints(0.5)
                    .FooterMargin = Application.InchesToPoints(0.5)
                    .CenterHorizontally = True
                    .RightFooter = "Compiled &D"
                End With
    
  End With
  
    ActiveCell.Offset(22, 0).Select
        Selection.Copy
    ActiveCell.Offset(-16, 0).Select
        ActiveSheet.Paste
    ActiveCell.Offset(16, 11).Select
        Selection.Copy
    ActiveCell.Offset(-15, -11).Select
        ActiveSheet.Paste
    ActiveCell.Offset(15, 6).Resize(, 2).Select
        Selection.Cut
    ActiveCell.Offset(-14, -6).Select
        ActiveSheet.Paste
    ActiveCell.Offset(14, 8).Select
        Selection.Cut
    ActiveCell.Offset(-13, -8).Select
        ActiveSheet.Paste
    ActiveCell.Offset(13, 9).Select
        Selection.Cut
    ActiveCell.Offset(-12, -9).Select
        ActiveSheet.Paste
    ActiveCell.Offset(12, 10).Select
        Selection.Cut
    ActiveCell.Offset(-11, -10).Select
        ActiveSheet.Paste
    ActiveCell.Offset(11, 11).Select
        Selection.Cut
    ActiveCell.Offset(-13, -8).Select
        ActiveSheet.Paste
    ActiveCell.Offset(13, 9).Select
        Selection.Cut
    ActiveCell.Offset(-12, -9).Select
        ActiveSheet.Paste
    ActiveCell.Offset(12, 10).Select
        Selection.Cut
    ActiveCell.Offset(-11, -10).Select
        ActiveSheet.Paste
    ActiveSheet.[a7:b13].Font.Bold = True
    ActiveSheet.[a16:f17].Font.Bold = True
    ActiveSheet.[a22:f22].Font.Bold = True
    Range("b10").Formula = "=concatenate(A9 & "" "" & B9)"
    Range("b11").Formula = "=concatenate(""Dear"" & "" "" & A8)"
    Range("B10").Copy
    Range("A9").Select
        Selection.PasteSpecial Paste:=xlPasteValues
    Range("B11").Select
        Selection.Copy
    Range("A15").Select
        Selection.PasteSpecial Paste:=xlPasteValues
    Range("b9:b11").Clear
    Range("A7:A12").Select
        Selection.IndentLevel = 4
    Range("C8:E9").Select
        Selection.HorizontalAlignment = xlCenter
        Selection.VerticalAlignment = xlCenter
        Range("C13:E14").Select
        Selection.HorizontalAlignment = xlCenter
        Selection.VerticalAlignment = xlCenter
    Range("c10:e12").Select
        Selection.IndentLevel = 4
    Range("C8:E14").Select
        Selection.Font.Size = 10
    Range("C8:f14").BorderAround Weight:=xlThick
    
    Range("G:P").Clear
    
  Next
End Sub

With this

Sub Mail_Every_Worksheet()
'Working in 97-2010
    Dim sh1 As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim I As Long




'Working in 97-2010
    

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    For Each sh1 In ThisWorkbook.Worksheets
        If sh1.Range("D12").Value Like "?*@?*.?*" Then

            sh1.Copy
            Set wb = ActiveWorkbook

            TempFileName = "AFRL" & sh.Name

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, _
                        FileFormat:=FileFormatNum
                On Error Resume Next
                For I = 1 To 3
                    .SendMail sh.Range("D12").Value, "A problem with your Automated First Registration and Licensing (AFRL) Account"
                    .ProtectSharing
                    If Err.Number = 0 Then Exit For
                Next I
                On Error GoTo 0
                .Close SaveChanges:=False
            End With

            'Delete the file you have send
            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh1
    
For Each sh1 In ThisWorkbook.Worksheets
        If sh1.Range("D12").Value = "0" Then

            sh1.Copy
            Set wb = ActiveWorkbook

            TempFileName = "AFRL" & sh.Name

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, _
                        FileFormat:=FileFormatNum
                On Error Resume Next
                For I = 1 To 3
                    .PrintOut Copies:=1
                    
                    If Err.Number = 0 Then Exit For
                Next I
                On Error GoTo 0
                .Close SaveChanges:=False
            End With

            'Delete the file you have send
            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh1
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

Application.DisplayAlerts = False
Sheets("Sheet1").Name = "ALL"
Sheets("ALL").Select

Const DirectoryToSaveIn As String = "C:\Documents and Settings\ButlerM2\Desktop\"
ActiveWorkbook.SaveAs Filename:=DirectoryToSaveIn & "Payments Chased - " & Format(Date, "dd.mm.yy") & ".xls"

Application.DisplayAlerts = True

Application.ScreenUpdating = True

Workbooks("Do Letters.xls").Close

Set myrange = Nothing
Set mainsh = Nothing

End Sub

So the work top one first and then the bottom one, it not a problem for me to upload files if needed.......................