The first section:
On Error Resume....
up to when I go to last empty Row - DOES NOT WORK. Can you tell me what I am doing wrong.
Thanks
Sub Save()
On Error Resume Next
Error (9)
Windows("PictureLog").Activate
If Not WorkbooksOpen("PictureLog.xls") Then
Workbooks.Open Filename:="C:My DocumentsMT PicturesPictureLog.xls"
End If
'Go to lest empty Row in "PictureLog.xls" file
Application.ScreenUpdating = False
Range("a6").Select
Do Until ActiveCell.Value = vbNullString
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
'Switch to Template Sheet
Windows("PictureTemplate").Activate
'Delete "Save" Button
ActiveSheet.Shapes("Text Box 4").Select
Selection.Delete
Range("E6").Select
'Save data to new xls file (seqential #)
Do Until Dir("C:My DocumentsMT PicturesJPG" & x & ".xls") = ""
x = x + 1
Loop
ActiveWorkbook.SaveAs "C:My DocumentsMT PicturesJPG" & CStr(x) & ".xls"
ActiveWorkbook.Close
End Sub
On Error Resume....
up to when I go to last empty Row - DOES NOT WORK. Can you tell me what I am doing wrong.
Thanks
Sub Save()
On Error Resume Next
Error (9)
Windows("PictureLog").Activate
If Not WorkbooksOpen("PictureLog.xls") Then
Workbooks.Open Filename:="C:My DocumentsMT PicturesPictureLog.xls"
End If
'Go to lest empty Row in "PictureLog.xls" file
Application.ScreenUpdating = False
Range("a6").Select
Do Until ActiveCell.Value = vbNullString
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
'Switch to Template Sheet
Windows("PictureTemplate").Activate
'Delete "Save" Button
ActiveSheet.Shapes("Text Box 4").Select
Selection.Delete
Range("E6").Select
'Save data to new xls file (seqential #)
Do Until Dir("C:My DocumentsMT PicturesJPG" & x & ".xls") = ""
x = x + 1
Loop
ActiveWorkbook.SaveAs "C:My DocumentsMT PicturesJPG" & CStr(x) & ".xls"
ActiveWorkbook.Close
End Sub