emailing a worksheet

[Kogersdad]

I am trying to write a "script/VBA" that would copy ONLY THE VISIBLE CELLS in a specified range (A4:H75) and paste AS VALUES into a new worksheet. Then email this new worksheet to the email address in the original spreadsheet's cell DW19. I have found some similar code so I am coming very close to making it work but i cant get it to copy the visible cells only and paste them as values. It is copying the entire sheet and emailing it.

here is what i have that is working - i.e. it sends me a copy of the entire sheet...

Sub Mail_Every_Worksheet()
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
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
Set OutApp = CreateObject("Outlook.Application")
For Each sh In ThisWorkbook.Worksheets
If sh.Range("DW19").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Sheet " & 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("DW19").Value
.CC = ""
.BCC = ""
.Subject = "Subject line"
.Body = ""
.Attachments.Add wb.FullName
.Send
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

 

[JP2112]

Do you want the range in the body of the email, or as a workbook attachment?

 

[Kogersdad]

I would like to have it as an attachment. Thanks!

 

[JP2112]

I am trying to write a "script/VBA" that would copy ONLY THE VISIBLE CELLS in a specified range (A4:H75) and paste AS VALUES into a new worksheet.

Put this at the top of your code, with the other declarations:

Dim newWorksheet As Excel.Worksheet

Inside your loop, create a new worksheet and copy the visible cells:

If sh.Range("DW19").Value Like "?*@?*.?*" Then
Worksheets.Add
Set newWorksheet = ActiveSheet
sh.Range("A4:H75").SpecialCells(xlCellTypeConstants).Copy newWorksheet.Range("A1")

Then save the new worksheet into a new workbook:

newWorksheet.SaveAs TempFileName

Attach the new workbook:

.Attachments.Add TempFileName