(No Macro Experience) Emailing each tab in a workbook

Hi sevanseriesta
This will give you an idea...What it does is as follows:
Loops through all sheets one at a time, copies sheet to newbook and saves on desktop
Add as attachment and emails to recipient....email address found in the sheet in Range("D1")
Deleted the file and then loops to next sheet doing the same....
have a look at attached sample.

Please Login or Register  to view this content.

Here is my current Macro, I didn't write it so I don't understand what anything means. This is making it very difficult for me to change what needs to be changed in the above script. Everytime I alter it I get an error when I try to run the macro.

Here is the script.

Sub SplitWorkbookbyTab()
'Updateby20140612
Dim FileExtStr As String, fnam As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
xWs.Copy
fnam = xWs.Name & " AR Aging"
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook.HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56:
FileExtStr = ".xls": FileFormatNum = 56
Case Else:
FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
xFile = FolderName & "\" & fnam & FileExtStr
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

This is the script you gave me an I edited it. ( I can't get it to work)

Option Explicit
Sub EmailSheet()
Dim recipient As String, subject As String
Dim ws As Worksheet
Dim newWorkbook As Workbook
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Sheets
Set newWorkbook = Excel.Workbooks.Add
ws.Copy newWorkbook.Sheets(newWorkbook.Sheets.Count)
newWorkbook.SaveAs "X:\Monthly Reporting\Management Accounts\CLUS\Weekly AR Reporting\MCL AR Reports" & ws.Name & ".xlsx"
With CreateObject("outlook.application").CreateItem(0)
.To = ActiveSheet.Range("D1")
.subject = "Open AR"
.body = "Good Day, Attached you will find the open AR for your accounts. If you have any questions please contact your Account Rep"
.Attachments.Add "C:\Users\Sintek\Desktop\" & ws.Name & ".xls"
.send
End With
ActiveWorkbook.Close saveChanges:=False
Kill "X:\Monthly Reporting\Management Accounts\CLUS\Weekly AR Reporting\MCL AR Reports" & ws.Name & ".xlsx"
Next ws

Application.ScreenUpdating = True
End Sub