Writing Values Of Cells Into Another Excel In VBA - vba

Question

I have this code to send e-mail with attached via Outlook:
Sub AutoEmail()
On Error GoTo Cancel
Dim Resp As Integer
Resp = MsgBox(prompt:=vbCr & "Yes = Review Email" & vbCr & "No = Immediately Send" & vbCr & "Cancel = Cancel" & vbCr, _
Title:="Review email before sending?", _
Buttons:=3 + 32)
Select Case Resp
'Yes was clicked, user wants to review email first
Case Is = 6
Dim myOutlook As Object
Dim myMailItem As Object
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
FName = Application.ActiveWorkbook.FullName
With otlNewMail
.To = Cells(33, 10)
.CC = Cells(1, 1)
.Subject = Cells(23, 10) & ": " & Cells(21, 10)
.Body = "Good morning" & vbCr & vbCr & "" & Cells(23, 10) & "."
.Attachments.Add FName
.Display
End With
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
'If no is clicked
Case Is = 7
Dim myOutlok As Object
Dim myMailItm As Object
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With otlNewMail
.To = ""
.CC = ""
.Subject = ""
.Body = "Good Morning," & vbCr & vbCr & " " & Format(Date, "MM/DD") & "."
.Attachments.Add FName
.Send
'.Display
'Application.Wait (Now + TimeValue("0:00:01"))
'Application.SendKeys "%s"
End With
'otlApp.Quit
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
'If Cancel is clicked
Case Is = 2
Cancel:
MsgBox prompt:="No Email has been sent.", _
Title:="EMAIL CANCELLED", _
Buttons:=64
End Select
End Sub
However there is another thing that i want to add. I want to write some cells into another excel after sending e-mail via Outlook, lets say A2 to B15. The excel file which i want to write on is in C:\Users\Computername\Desktop\Savingdata.xlsx

Answer 1

Mert,
Try the following, add these two lines at the beginning of your code:
Dim wbThisWorkbook, wbTheOneToSaveTo As Workbook
Set wbThisWorkbook = Workbooks("TheNameOfYourCurrentWorkbook")
Then after your sending routine, add this:
Set wbTheOneToSaveTo = Workbooks.Open ("C:\Users\Computername\Desktop\Savingdata.xlsx")
wbThisWorkbook.Sheets("TheNameOfThe Worksheet").Range("A2").Copy
wbTheOneToSaveTo.Sheets("TheNameOfTheWorksheet").Range("B15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'adjust parameters according to your needs
wbTheOneToSaveTo.Close True
wbThisWorkbook.Activate
Hope this helps!