Need Help with this program to create unique workbook, save, mail and delete

[ksghumaria]

Hi I'm trying to modify the excel program to copy customised worksheet in new workbook, saving it as temp then mailing this workbook and then deleting it.
I am having following difficulties:
1. If- else if statement not working
2. Showing object error

Sub Send_sheet()

Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim DataWB As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Integer
Dim NewWB As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim k As Worksheet
Dim product

On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")

With Application
.EnableEvents = False
.ScreenUpdating = True

End With

Set DataWB = Sheets("DATA")
Set FilterRange = DataWB.Range("A1:K" & DataWB.Rows.Count)
FieldNum = 2 'Filter column = B because the filter range start in column A

Set Cws = Worksheets.Add
Cws.Name = "Email IDs"

FilterRange.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Cws.Range("A1"), _
CriteriaRange:="", Unique:=True

Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
If Rcount >= 2 Then
For Rnum = 2 To Rcount
product = Sheets("DATA").Cells(Rnum, 4)
'If the unique value is a mail addres create a mail
If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" Then

'Filter the FilterRange on the FieldNum column
FilterRange.AutoFilter Field:=FieldNum, _
Criteria1:=Cws.Cells(Rnum, 1).Value

'Copy the visible data in a new workbook
With DataWB.AutoFilter.Range
On Error Resume Next
'MsgBox (product)
If product = 1000 Or 3000 Then
Sheets("A").Select
ElseIf product = 2000 Then
Sheets("B").Select
ElseIf product = 4000 Then
Sheets("C”).Select
End If
Range("C5").Value = Sheets("DATA").Cells(Rnum, 1).Value
Range("C6").Value = Sheets("DATA").Cells(Rnum, 3).Value
Range("C9").Value = Sheets("DATA").Cells(Rnum, 7).Value
Range("C12").Value = Sheets("DATA").Cells(Rnum, 5).Value
Range("E16").Value = Sheets("DATA").Cells(Rnum, 8).Value
Range("E18").Value = Sheets("DATA").Cells(Rnum, 9).Value
Range("E19").Value = Sheets("DATA").Cells(Rnum, 10).Value
Range("E23").Value = Sheets("DATA").Cells(Rnum, 11).Value
Range("I18").Value = 12
k = ActiveSheet.copy
On Error GoTo 0
End With

NewWB = Workbook.Add ' showing error

ThisWorkbook.Sheets.k.Copy before:=NewWB.Sheets(1) 'showing error
Application.CutCopyMode = False
Range("A4").Select
ActiveWindow.FreezePanes = True

'Create a file name
TempFilePath = Environ$("temp") & "\"
TempFileName = DataWB.Parent.Name _
& " " & Format(Now, "dd-mmm-yy h-mm-ss")

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

'Save, Mail, Close and Delete the file
Set OutMail = OutApp.CreateItem(0)

With NewWB
.SaveAs TempFilePath & TempFileName _
& FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = Cws.Cells(Rnum, 1).Value
.Subject = "XYZABC12345"
.Attachments.Add NewWB.FullName
.Body = "Hello Everyone”
.display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
End If

'Close AutoFilter
DataWB.AutoFilterMode = False

Next Rnum
End If

cleanup:
Set OutApp = Nothing
Application.DisplayAlerts = False
Cws.Delete
Application.DisplayAlerts = True

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

 

[steve the fish]

Hi

Try:

If product = 1000 Or product = 3000 Then

 

[ksghumaria]

Hey Steve
Thank for the reply.
Perfect answer, it works..
Thanks a lot .

Please help with the NewWB code.

 

[steve the fish]

Which sheet are you trying to copy there?

 

[ksghumaria]

The sheet 'if- Then-elseif' condition selects. That will become the active sheet,I want that sheet to be converted as new workbook for mailing.

 

[ksghumaria]

The sheets are variable as per the result of if-Then-Elseif statement.

 

[ksghumaria]

Need Help with the Program. How to save unique sheets, save in temp, email and delete. Please Help!!