Word VBA update excel sheet from userform

[aislinLen]

Hello all! I was hoping that someone here might be able to help me a little further.

I have created a Word Template with userform and many many bookmarks which is used to create customer order quotes. I am still very new to VBA so it is very basic but it does the trick. I would like to extend its abilities to, and am struggling to find a logical solution.

I would like to, when a user clicks a CmdButton_Excel, copy values in certain textboxes into an excel file (in the next empty row). At the minute, I can open the excel document I want but then I am lost. I have posted the initial code below, it isn't very extendable as i specify A2 B2 C2 and the online forums seem sot bring me round in circles.

While I am already asking for help, I am actually looking to paste these cells into a specific worksheet. I have named them 2015, 2016 etc and depending on the current actual year, I'd like to values to be pasted into that worksheet. Have played with Year(Now()), and can at least open the worksheet...but not sure how to extend this into my copy paste code.

I really appreciate any help I might be able to find here.

Aislin


Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim strName As String


Set xlApp = CreateObject("Excel.Application")


strName = "C:\Users\Ween\Documents\VBA_Testing\Angebote.xlsm"
Set xlBook = xlApp.Workbooks.Open(strName)


Set xlSheet = xlBook.Worksheets("Master")
xlSheet.Range("A" & 2) = ActiveDocument.Bookmarks("CustNum").Range.Text
xlSheet.Range("B" & 2) = ActiveDocument.Bookmarks("Dept").Range.Text
xlSheet.Range("C" & 2) = ActiveDocument.Bookmarks("Engine").Range.Text
xlApp.Visible = True

[gmayor]

The next steps are simple enough, you need to establish whether the sheet name exists and if it doesn't, create it and its header row, then establish the next available row:


Sub CopyToExcel()
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim strName As String
Dim bFound As Boolean
Dim NextRow As Long
strName = "C:\Users\Ween\Documents\VBA_Testing\Angebote.xlsm"

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0

Set xlBook = xlApp.Workbooks.Open(strName)
xlApp.Visible = True

For Each xlSheet In xlBook.Worksheets
If xlSheet.name = Trim(Year(Date)) Then
bFound = True
Exit For
End If
Next xlSheet
If Not bFound Then
Set xlSheet = xlBook.Worksheets.Add
xlSheet.name = Year(Date)
xlSheet.Range("A1") = "CustNum"
xlSheet.Range("B1") = "Dept"
xlSheet.Range("C1") = "Engine"
End If

NextRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row + 1
xlSheet.Range("A" & NextRow) = ActiveDocument.Bookmarks("CustNum").Range.Text
xlSheet.Range("B" & NextRow) = ActiveDocument.Bookmarks("Dept").Range.Text
xlSheet.Range("C" & NextRow) = ActiveDocument.Bookmarks("Engine").Range.Text
xlBook.Close SaveChanges:=True
lbl_Exit:
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
End Sub

[aislinLen]

Hi Graham,

Thank you for your quick reply!! I will try this out as soon as I get the chance. :) :)

[aislinLen]

It worked it worked it worked! And was able to modify the Sub to make a new function so thank you very much!