Hi,
log.xls and test.xls created but when trying to close test.xls as intended
I get a "Subscript out of range" error on line
---------
Set log_wbk = Workbooks(log_filename)
-----------
will let you know from there on
Ragards
Martyn


"Frank Kabel" wrote in message
...
Hi
try the following - not fully tested as I didn't have the same
environment as you have and to be honest i'm a little bit lazy to
re-create it :-)
Put the following code in your test.xls workbook module. Create the
log.xls workbook prior to running this code. You may have to change the
names of your sorce worksheet as I'm not so sure about the names of
these sheets

-----
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim log_wbk As Workbook
Dim log_wks As Worksheet
Dim last_log_row As Long
Dim path As String
Dim log_filename As String
Dim source_wbk As Workbook
Dim source_wks As Worksheet


'Initialization
Application.ScreenUpdating = False
path = "D:\Temp\"
log_filename = "log.xls"
Set source_wbk = ActiveWorkbook


'check if logging workbook is open / if not open it
On Error Resume Next
Set log_wbk = Workbooks(log_filename)
On Error GoTo 0
If log_wbk Is Nothing Then
Workbooks.Open filename:=path & log_filename
Set log_wbk = Workbooks(log_filename)
End If
Set log_wks = log_wbk.Worksheets("sheet1") 'change this

'get last used row
last_log_row = log_wks.Cells(Rows.Count, "A").End(xlUp).row

'log data - change to your needs
With log_wks
.Cells(last_log_row + 1, 1).Value = Application.UserName
.Cells(last_log_row + 1, 2).Value = _
Format(Now, "MM/DD/YYYY hh:mm:ss")
Set source_wks = source_wbk.Worksheets("sheet14")
.Cells(last_log_row + 1, 3).Value = source_wks.Range("A4").Value
.Cells(last_log_row + 1, 4).Value = source_wks.Range("A10").Value

Set source_wks = source_wbk.Worksheets("sheet15")
.Cells(last_log_row + 1, 5).Value = source_wks.Range("A9").Value

Set source_wks = source_wbk.Worksheets("sheet12")
.Cells(last_log_row + 1, 6).Value = source_wks.Range("A9").Value
End With


' save the changes
Application.DisplayAlerts = True
log_wbk.Save
log_wbk.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


------


--
Regards
Frank Kabel
Frankfurt, Germany