I require VBA Code to automatically sync certain cell data to a seperate excel template

Hi Bernie,

I did send a response yesterday afternoon thanking you for your time, but it doesn't appear to have shown up, so apologies.

I have been playing around with this code, but with little success. As I alluded to, I am somewhat of a novice, especially as far as VBA / macros are concerned.

I assume this code runs from the form template, rather than the tenancy system files which I save for each separate client?

Is this the best way round for me to complete this task, or should I run the code from within the tenants workbook via clicking a created button?

I currently use a "sendmail" operation this way, which opens up outlook and inserts the required information in to the relevant email fields (email address, subject, message body and signature).

I have included a copy of this code below, as it may explain how it works better than I am (that wouldn't be too hard )

Any thoughts / ideas would be greatly appreciated. I have a tendency to sometimes over complicate things and given as I am not 100% sure what I'm doing here, would like to keep things as simple as possible.

------------

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Cells(ActiveCell.Row, 7)


Subj = Cells(ActiveCell.Row, 9)

Msg = Msg & "Dear " & Cells(ActiveCell.Row, 8) & "," & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 10) & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 11) & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 12) & vbCrLf & Cells(ActiveCell.Row, 13) & vbCrLf & Cells(ActiveCell.Row, 14) & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 15) & vbCrLf & vbCrLf & "Kind regards," & vbCrLf & vbCrLf & "Peter."

'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

'Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'Wait two seconds before sending keystrokes
'Application.Wait (Now + TimeValue("0:00:04"))
'Application.SendKeys "%s"
End Sub
Sub InsertSig(strSigName As String)
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' requires a project reference to the
' Microsoft Word library
Dim objDoc As Word.Document
Dim objSel As Word.Selection
' requires a project reference to the
' Microsoft Office library
Dim objCB As Office.CommandBar
Dim objCBP As Office.CommandBarPopup
Dim objCBB As Office.CommandBarButton
Dim colCBControls As Office.CommandBarControls
On Error Resume Next

Set objInsp = Application.ActiveInspector
If Not objInsp Is Nothing Then
Set objItem = objInsp.CurrentItem
If objItem.Class = olMail Then ' editor is WordMail
If objInsp.EditorType = olEditorWord Then
' next statement will trigger security prompt
' in Outlook 2002 SP3
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Application.Selection
If objDoc.Bookmarks("_MailAutoSig") Is Nothing Then
objDoc.Bookmarks.Add Range:=objSel.Range, Name:="_MailAutoSig"
End If
objSel.Goto What:=wdGoToBookmark, Name:="_MailAutoSig"
Set objCB = objDoc.CommandBars("AutoSignature Popup")
If Not objCB Is Nothing Then
Set colCBControls = objCB.Controls
End If
Else ' editor is not WordMail
' get the Insert | Signature submenu
Set objCBP = Application.ActiveInspector.CommandBars.FindControl(, 31145)
If Not objCBP Is Nothing Then
Set colCBControls = objCBP.Controls
End If
End If
End If
If Not colCBControls Is Nothing Then
For Each objCBB In colCBControls
If objCBB.Caption = strSigName Then
objCBB.Execute ' **** see remarks
Exit For
End If
Next
End If
End If

Set objInsp = Nothing
Set objItem = Nothing
Set objDoc = C: .Users.Peter Wade.AppData.Roaming.Microsoft.Signatures
Set objSel = Nothing
Set objCB = Nothing
Set objCBB = Nothing
End Sub