VBA copy Values exclude 1 column and formula

[bombergirl61]

Good afternoon

I have a spreadsheet that has a lot of formulas. I copy the spreadsheet and send via out look. At present I copy the used range and values.

I actually need to copy all columns accept N as a value, N needs to keep its formula in the sheet that is attached to the email.

Below is what I current have, I think i need to somewhere change the range to A:m,O:Z. I need to ensure when the person receives the spreadsheet and enters data that column N calculates

Sub Z_Mail_TUBE_PIPE_BUYTEST()
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim DueDate As String
DueDate = Format(ThisWorkbook.Sheets("National").Range("ad1").Value, "dd-mmm-yyyy")

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

If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

FileExtStr = ".xlsm": FileFormatNum = 52
End If

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

Set OutApp = CreateObject("Outlook.Application")

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

sh.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With ActiveSheet
.UsedRange.Value = UsedRange.Value
.Name = sh.Name & Format(Now, "dd-mmm-yy h-mm-ss")
.Move
End With
Set wb = ActiveWorkbook

TempFileName = sh.Name & " of " _
& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")


Set OutMail = OutApp.CreateItem(0)

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

On Error Resume Next
With OutMail
.To = sh.Range("A1").Value
.CC = ""
.BCC = ""
.Subject = "TUBE AND PIPE REQUIREMENTS"
.Body = "Hello" & vbNewLine & "Tube and Pipe Overseas purchase " & vbNewLine & "Please complete Column M with your requirements," & vbNewLine & "Return by " & DueDate & vbNewLine & vbNewLine & "Cheers" & vbNewLine & "Cheryl "
.Attachments.Add wb.FullName

.Display
End With
On Error GoTo 0

.Close savechanges:=False
End With

Set OutMail = Nothing

Kill TempFilePath & TempFileName & FileExtStr

End If
Next sh

Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Anthony47]

Try replacing the line .UsedRange.Value = UsedRange.Value with

    Application.Intersect(.UsedRange, .Range("A:M")).Value = Application.Intersect(.UsedRange, .Range("A:M")).Value
    Application.Intersect(.UsedRange, .Range("O:ZZ")).Value = Application.Intersect(.UsedRange, .Range("O:ZZ")).Value

This assumes your worksheet has less than 700 columns

 

[bombergirl61]

Try replacing the line .UsedRange.Value = UsedRange.Value with

    Application.Intersect(.UsedRange, .Range("A:M")).Value = Application.Intersect(.UsedRange, .Range("A:M")).Value
    Application.Intersect(.UsedRange, .Range("O:ZZ")).Value = Application.Intersect(.UsedRange, .Range("O:ZZ")).Value

This assumes your worksheet has less than 700 columns

Thank you so very much works like a charm. appreciate your help.