Copy values only to new workbook

[micko1]

Need help. I have a macro that now copies a sheet out of a workbook, attaches it to an email and sends it off. Problem I have is when the sheet bis copied it takes the formulas and links with it. I have tried a couple of things but can't seem to get it right.
Thanks for taking the time to look at this for me.

Mick

Sub Rego_Due_2weeks()
Dim rngCell As Range
    Dim rngMyDataSet As Range
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailSubject As String
    Dim EmailSendTo As String
    Dim MailBody As String
    Dim EmailRecipient As String
    Dim SigString As String
    Dim Signature As String
    Dim wksht As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
 
TempFilePath = Environ$("temp") & "\"
With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With
 
 
    With ActiveSheet
    If .FilterMode Then .ShowAllData
 
    Set rng = .Range("A7", .Cells(.Rows.Count, 1).End(xlUp))
  End With
 'Check if email was sent prior
    For Each rngCell In rng
    If rngCell.Offset(0, 13) > 0 Then
 
'Rego due 2 weeks from Due date
 
          ElseIf rngCell.Offset(0, 6) > Evaluate("Today()") And _
          rngCell.Offset(0, 6).Value <= Evaluate("Today() +14") Then
                Set wksht = Worksheets(rngCell.Offset(0, 5).Value)
      wksht.Copy
      Set wb = ActiveWorkbook
      TempFileName = wksht.Name
 
    FileExtStr = ".xls": FileFormatNum = 56
      With wb
         .SaveAs TempFilePath & TempFileName & FileExtStr
         On Error Resume Next
         For i = 1 To 3
 
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
 
    strbody = "Dear  " & rngCell.Value & vbNewLine & vbNewLine & _
              "Vehicle " & rngCell.Offset(0, 5).Value & " registration is due for renewal on " & rngCell.Offset(0, 6).Value & " please arranged inspection at your earliest convenience." & vbNewLine & vbNewLine & vbNewLine & _
              "Thank you for your co-operation in this matter."
 
 
    EmailSendTo = Replace(rngCell.Hyperlinks(1).Address, "mailto:", "")
    EmailSubject = "Vehicle Registrations Due for Renewal"
    EmailRecipient = rngCell.Value
 
 
    On Error Resume Next
    With OutMail
        .To = EmailSendTo
        .CC = ""
        .BCC = ""
        .Subject = EmailSubject
        .Body = strbody
        .Attachments.Add ActiveWorkbook.FullName
 
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
    If Err.Number = 0 Then Exit For
         Next i
         On Error GoTo 0
         .Close SaveChanges:=False
      End With
 
      Kill TempFilePath & TempFileName & FileExtStr
   End If
 
If rngCell.Offset(0, 6) > Evaluate("Today()") And _
          rngCell.Offset(0, 6).Value <= Evaluate("Today() +14") Then
                rngCell.Offset(0, 13).Value = Date
End If
Next rngCell
With Application
   .ScreenUpdating = True
   .EnableEvents = True
End With
End Sub

 

[VoG]

Try adding the lines in red

      ElseIf rngCell.Offset(0, 6) > Evaluate("Today()") And _
          rngCell.Offset(0, 6).Value <= Evaluate("Today() +14") Then
                Set wksht = Worksheets(rngCell.Offset(0, 5).Value)
      wksht.Copy
      With ActiveSheet.UsedRange
        .Value = .Value
      End With
      Set wb = ActiveWorkbook
      TempFileName = wksht.Name

 

[micko1]

Thanks very much for you taking the time to assist, but code does not work. in the copied workbook it places #VALUE! in all cells that had lookup formulas in them. I tried somthing similar and was geting the same result. Not sure what to do.

Mick

 

[micko1]

Been trying lots of stuff and this appears to work. What do you think.

Mick

[COLOR=black]ElseIf rngCell.Offset(0, 6) > Evaluate("Today()") And _[/COLOR]
[COLOR=black]         rngCell.Offset(0, 6).Value <= Evaluate("Today() +14") Then[/COLOR]
[COLOR=black]               Set wksht = Worksheets(rngCell.Offset(0, 5).Value)       [/COLOR]
[COLOR=black]                 wksht.Copy[/COLOR]
[COLOR=black]     Set wb = ActiveWorkbook[/COLOR]
[COLOR=black]     TempFileName = wksht.Name[/COLOR]
[COLOR=#ff0000]wb.ActiveSheet.UsedRange.Value = wksht.UsedRange.Value      [/COLOR]
[COLOR=black]FileExtStr = ".xls": FileFormatNum = 56[/COLOR]
[COLOR=black]     With wb[/COLOR]
[COLOR=black]        .SaveAs TempFilePath & TempFileName & FileExtStr[/COLOR]