VBA copy Values exclude 1 column and formula

bombergirl61

New Member
Joined
Nov 19, 2014
Messages
10
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
 
Last edited:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Try replacing the line .UsedRange.Value = UsedRange.Value with
VBA Code:
    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
 
Upvote 0
Try replacing the line .UsedRange.Value = UsedRange.Value with
VBA Code:
    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.
 
Upvote 0
Thank you so very much works like a charm. appreciate your help.

03/02/2025
HI

Any tips why this code would just stop working. I use debug and it halts at

If sh.Range("A1").Value Like "?*@?*.?*" Then

Whole code below

VBA Code:
Sub Z_Mail_SHEET_BUY_ALUMINIUM_all()
    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
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        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
Application.Intersect(.UsedRange, .Range("A:l")).Value = Application.Intersect(.UsedRange, .Range("A:l")).Value
    Application.Intersect(.UsedRange, .Range("n:Z")).Value = Application.Intersect(.UsedRange, .Range("n:Z")).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 = "ALUMINIUM REQUIREMENTS"
                    .Body = Format(ThisWorkbook.Sheets("National").Range("ae1").Value, "VB")
                    .Attachments.Add wb.FullName
                    'You can add other files also like this
                    '.Attachments.Add ("C:\test.txt")
                    .Display 'disable display and enable send to send automaticall
                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
 
Upvote 0
@bombergirl61
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block at the bottom of this post has more details. I have added the tags for you this time. 😊
 
Upvote 0
@bombergirl61
One more thing. Please do not mark a post as the answer to your question unless it is that. I have removed the 'Mark as solution' from post #5.
1738555989497.png
 
Upvote 0
Any tips why this code would just stop working. I use debug and it halts at
If sh.Range("A1").Value Like "?*@?*.?*" Then
@bombergirl61
Maybe you already solved the problem, but my best guess is that Range("A1") of a sheet displays an error condition.
If this is the case, than you might add an additional If /End If as follows:
VBA Code:
    For Each Sh In ThisWorkbook.Worksheets
        If Not IsError(Sh.Range("A1").Value) Then               '<<< Added If
            If Sh.Range("A1").Value Like "?*@?*.?*" Then
                'your code
                'your code

                Kill TempFilePath & TempFileName & FileExtStr
            End If
        End If                                              '<<< Added End If
    Next Sh
 
Upvote 0

Forum statistics

Threads
1,226,739
Messages
6,192,739
Members
453,754
Latest member
milestogo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top