Hi John,

Just returned from my trip and tried your code. It worked like a charm!
Thanks so much for your help!

Regards,
Chris

"john" wrote:

see if this approach will do what you want.

Sub SaveData_Click()

Dim SourceRange As Range
Dim DestRange As Range

Dim NewBook As Workbook
Dim TDFormWb As Workbook

Dim OldShcount
Dim mypath As String


Set TDFormWb = Workbooks(ThisWorkbook.Name)

'Before copying, ensure a serial number
'has been entered correctly.
With TDFormWb.Worksheets("Post-Service").Range("D3")

.Value = UCase(.Value)

If .Value = "" Then

.Select

msg = MsgBox("You must enter a serial number.", _
16, "Serial Number Error")


Exit Sub

ElseIf Left(.Value, 1) < "C" Then

.Select

msg = MsgBox("Are you sure the serial number doesn't begin with
C?", _
36, "Serial Number Error")

If msg = 7 Then

msg = MsgBox("Please fix the serial number.", _
16, "Serial Number Error")

Exit Sub

End If

End If

End With

With Application

OldShcount = .SheetsInNewWorkbook

.SheetsInNewWorkbook = 2

mypath = .Path

End With

'The following code creates a new workbook
'& renames the worksheets
Set NewBook = Workbooks.Add

With NewBook
.Title = "Sensor Data"
.Subject = ""
.Comments = ""
.Author = Application.UserName

.Sheets(1).Name = "Pre-Service"
.Sheets(2).Name = "Post-Service"
End With


'Reset no sheets in new workbook
'back to orig setting
Application.SheetsInNewWorkbook = OldShcount
'

'copies the template data into the new workbook.
'VBA worksheet Code & sheet objects are not copied.

With TDFormWb

Set SourceRange = .Sheets("Pre-Service").Cells
Set DestRange = NewBook.Worksheets("Pre-Service").Range("A1")

SourceRange.Copy

DestRange.PasteSpecial xlPasteAll, , False, False
Application.CutCopyMode = False
Set SourceRange = Nothing
Set DestRange = Nothing

Set SourceRange = .Sheets("Post-Service").Cells
Set DestRange = NewBook.Worksheets("Pre-Service").Range("A1")

SourceRange.Copy

DestRange.PasteSpecial xlPasteAll, , False, False
Application.CutCopyMode = False
Set SourceRange = Nothing
Set DestRange = Nothing

End With

'save the new workbook to the network and
'rename it.

With NewBook

.SaveAs "\\MyPath\" & "SR50_SN_" & Range("d3") _
& "_" & Format(Now, "yyyymmmdd") & _
Range("d5").Value & _
"_" & ".xls"


'close new workbook
.Close False

End With

msg = MsgBox("Workbook data has been copied & Saved!", _
vbInformation, "Copy Workbook Data")

Set NewBook = Nothing

End Sub

--
jb


"CB" wrote:

Hello,

Members of this newsgroup have been instrumental in helping me get my code
as far as Ive gone. I have what I think is my final problem that I need help
with.

Users will be using my workbook to collect sensor data, save a copy of the
data to another file using a command button, then use another command button
to clear the data from the original file so they can test another sensor. The
process can be repeated as often as necessary.

I finally have my €œSave Data€� command button working how I want it to.
However, the button will NOT work properly a second or subsequent time. I
think I know exactly why it is behaving this way; Im not sure how to fix it.
Im thinking I need some type of loop but Im not sure which is the best
method (Do€¦Loop, For€¦Next, For€¦Each€¦Next, If€¦Then€¦Else) and how to implement
it.

In a nutshell, my €œSave Data€� command button does the following:
- open a new workbook (i.e., €œBook1€�)
- copy two worksheets from the original workbook to the new workbook
- save a COPY of the new workbook to the network with a new name
- close the new workbook (i.e., €œBook1€�) without saving changes

The problem is that since the original workbook is NOT closed between each
sensors test, the second time the €œSave Data€� button is clicked (for the
second sensor) the new workbook created is now €œBook2€�. I then get a run-time
error because the code contains €œBook1.€� What Im thinking I need to do is
increment €œBook#€� each time the command button is clicked. I just dont know
how.

Im including the code for my €œSave Data€� command button if it will help.

Thanks in advance!

Chris

Private Sub SaveData_Click()

'The following code creates a new workbook and copies the worksheets from
the template into the new workbook. Code isn't copied.

Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Pre-Service"
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Post-Service"
Sheets("Pre-Service").Select
Windows("SR50_Test_Data_Form_v2.xls").Activate
Sheets("Pre-Service").Select
ActiveSheet.Cells.Select
Selection.Copy
Windows("Book1").Activate
ActiveSheet.Paste
Sheets("Post-Service").Select
Windows("SR50_Test_Data_Form_v2.xls").Activate
Sheets("Post-Service").Select
ActiveSheet.Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
ActiveSheet.Paste
Windows("SR50_Test_Data_Form_v2.xls").Activate
Windows("Book1").Activate
Application.CutCopyMode = False

'The following code saves a COPY of the new workbook to the network and
renames it. Before copying, it ensures a serial number was entered.
If Trim(Worksheets("Post-Service").Range("D3").Value = "") Then
MsgBox ("You must enter a serial number.")
Exit Sub
Else
Worksheets("Post-Service").Range("D3") =
UCase(Worksheets("Post-Service").Range("D3"))
If Left(Worksheets("Post-Service").Range("D3"), 1) = "C" Then
ActiveWorkbook.SaveCopyAs "\\MyPath\" & "SR50_SN_" & Range("d3")
& "_" & Format(Now, "yyyymmmdd") & Range("d5") & "_" & ".xls"
Else
If MsgBox("Are you sure the serial number doesn't begin with
C?", vbYesNo) = vbYes Then
ActiveWorkbook.SaveCopyAs "\\MyPath\" & "SR50_SN_" & Range("d3")
& "_" & Format(Now, "yyyymmmdd") & Range("d5") & "_" & ".xls"
Else
MsgBox ("Please fix the serial number.")
End If
End If
End If

Windows("Book1").Close Savechanges:=False

End Sub