My code is below. Here is what I ahve so far. I am trying to copy a
couple of sheets from a workbook to a new workbook to eliminate all
teh vba code, then save the file as the same name. any help woudl be
appreciated. There are a few other steps I have to go through, the
saving code is at the bottom.

Thanks,
Jay

Sub TearItDown()
Dim Nm As String
Dim FlNm As String
Dim Bk As Workbook
Set Bk = ActiveWorkbook
Nm = Bk.Name
FlNm = Bk.FullName
If ActiveWorkbook.Name = "New Item Master.xls" Then
MsgBox "You are not allowed to delete" & vbCrLf & _
" anything from this master." & vbCrLf & _
"Please save file with a new" & vbCrLf & _
"item number first"
Exit Sub
Else
Range("A5").Select
Sheet1.Range("F4") = Sheet1.Range("F4").Value * 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheet4.Range("A1:K82").Copy
Sheet4.Range("A1").PasteSpecial xlPasteValues
With Sheet1.Range("A1:G90").Validation
.Delete
End With
Sheet1.Range("A14:G90").Copy
Sheet1.Range("A14").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("I:V").Delete
Sheets("Cab Quantities").Delete

Dim shp As Shape
Dim myVar As Shapes

Sheet1.Activate
Count = ActiveSheet.Shapes.Count

For i = Count To 1 Step -1
ActiveSheet.Shapes(i).Delete 'myVar(i).Delete
Next i

Sheets(Array("Master", "NI Worksheet")).Select
Sheets("Master").Activate
Sheets(Array("Master", "NI Worksheet")).Copy
Set CopyBook = ActiveWorkbook
Workbooks(Nm).Close
CopyBook.SaveAs (FlNm)

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub

Hi,

Your post title says "move" your discussion says "copy"?

It doesn't look like your code is designed to do a move command, instead it
looks like it is doing a copy.

The code to move sheets would look like this:

Sheets(Array("Sheet1", "Sheet2")).Move

What problem are you having?

I haven't tested this but here are some possible changes:


Sub TearItDown()
Dim Nm As String
Dim FlNm As String
Dim Bk As Workbook
Dim shp As Shape
Dim myVar As Shapes
Dim i As Integer
Set Bk = ActiveWorkbook
Nm = Bk.Name
FlNm = Bk.FullName
If ActiveWorkbook.Name = "New Item Master.xls" Then
MsgBox "You are not allowed to delete" & vbCrLf & _
" anything from this master." & vbCrLf & _
"Please save file with a new" & vbCrLf & _
"item number first"
Exit Sub
Else

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheet4.Range("A1:K82").Copy
Sheet4.Range("A1").PasteSpecial xlPasteValues
Sheets("Cab Quantities").Delete

Sheet1.Activate
Range("F4") = Range("F4").Value
Range("A1:G90").Validation.Delete
Range("A14:G90").Copy
Range("A14").PasteSpecial xlPasteValues
Range("I:V").Delete
Count = ActiveSheet.Shapes.Count
For i = Count To 1 Step -1
ActiveSheet.Shapes(i).Delete 'myVar(i).Delete
Next i
Sheets(Array("Master", "NI Worksheet")).Copy
ActiveWorkbook.SaveAs (FlNm)
Workbooks(Nm).Close
Application.DisplayAlerts = True
End If
End Sub

--
If this helps, please click the Yes button

Cheers,
Shane Devenshire


"jlclyde" wrote:

My code is below. Here is what I ahve so far. I am trying to copy a
couple of sheets from a workbook to a new workbook to eliminate all
teh vba code, then save the file as the same name. any help woudl be
appreciated. There are a few other steps I have to go through, the
saving code is at the bottom.

Thanks,
Jay

Sub TearItDown()
Dim Nm As String
Dim FlNm As String
Dim Bk As Workbook
Set Bk = ActiveWorkbook
Nm = Bk.Name
FlNm = Bk.FullName
If ActiveWorkbook.Name = "New Item Master.xls" Then
MsgBox "You are not allowed to delete" & vbCrLf & _
" anything from this master." & vbCrLf & _
"Please save file with a new" & vbCrLf & _
"item number first"
Exit Sub
Else
Range("A5").Select
Sheet1.Range("F4") = Sheet1.Range("F4").Value * 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheet4.Range("A1:K82").Copy
Sheet4.Range("A1").PasteSpecial xlPasteValues
With Sheet1.Range("A1:G90").Validation
.Delete
End With
Sheet1.Range("A14:G90").Copy
Sheet1.Range("A14").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("I:V").Delete
Sheets("Cab Quantities").Delete

Dim shp As Shape
Dim myVar As Shapes

Sheet1.Activate
Count = ActiveSheet.Shapes.Count

For i = Count To 1 Step -1
ActiveSheet.Shapes(i).Delete 'myVar(i).Delete
Next i

Sheets(Array("Master", "NI Worksheet")).Select
Sheets("Master").Activate
Sheets(Array("Master", "NI Worksheet")).Copy
Set CopyBook = ActiveWorkbook
Workbooks(Nm).Close
CopyBook.SaveAs (FlNm)

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub

On Feb 23, 2:53*pm, Shane Devenshire
wrote:
Hi,

Your post title says "move" your discussion says "copy"?

It doesn't look like your code is designed to do a move command, instead it
looks like it is doing a copy. *

The code to move sheets would look like this:

Sheets(Array("Sheet1", "Sheet2")).Move

What problem are you having?

I haven't tested this but here are some possible changes:

Sub TearItDown()
* * Dim Nm As String
* * Dim FlNm As String
* * Dim Bk As Workbook
* * Dim shp As Shape
* * Dim myVar As Shapes
* * Dim i As Integer
* * Set Bk = ActiveWorkbook
* * Nm = Bk.Name
* * FlNm = Bk.FullName
* * If ActiveWorkbook.Name = "New Item Master.xls" Then
* * * * MsgBox "You are not allowed to delete" & vbCrLf & _
* * * * " anything from this master." & vbCrLf & _
* * * * "Please save file with a new" & vbCrLf & _
* * * * "item number first"
* * * * Exit Sub
* * Else

* * * * Application.ScreenUpdating = False
* * * * Application.DisplayAlerts = False
* * * * Sheet4.Range("A1:K82").Copy
* * * * Sheet4.Range("A1").PasteSpecial xlPasteValues
* * * * Sheets("Cab Quantities").Delete

* * * * Sheet1.Activate
* * * * Range("F4") = Range("F4").Value
* * * * Range("A1:G90").Validation.Delete
* * * * Range("A14:G90").Copy
* * * * Range("A14").PasteSpecial xlPasteValues
* * * * Range("I:V").Delete
* * * * Count = ActiveSheet.Shapes.Count
* * * * For i = Count To 1 Step -1
* * * * * * ActiveSheet.Shapes(i).Delete 'myVar(i).Delete
* * * * Next i
* * * * Sheets(Array("Master", "NI Worksheet")).Copy
* * * * ActiveWorkbook.SaveAs (FlNm)
* * * * Workbooks(Nm).Close
* * * * Application.DisplayAlerts = True
* * End If
End Sub

--
If this helps, please click the Yes button

Cheers,
Shane Devenshire



"jlclyde" wrote:
My code is below. *Here is what I ahve so far. *I am trying to copy a
couple of sheets from a workbook to a new workbook to eliminate all
teh vba code, then save the file as the same name. *any help woudl be
appreciated. *There are a few other steps I have to go through, the
saving code is at the bottom.

Thanks,
Jay

Sub TearItDown()
* * Dim Nm As String
* * Dim FlNm As String
* * Dim Bk As Workbook
* * Set Bk = ActiveWorkbook
* * Nm = Bk.Name
* * FlNm = Bk.FullName
* * If ActiveWorkbook.Name = "New Item Master.xls" Then
* * MsgBox "You are not allowed to delete" & vbCrLf & _
* * * * " anything from this master." & vbCrLf & _
* * * * * * "Please save file with a new" & vbCrLf & _
* * * * * * "item number first"
* * * * Exit Sub
* * Else
* * * * Range("A5").Select
* * * * Sheet1.Range("F4") = Sheet1.Range("F4").Value * 1
* * * * Application.ScreenUpdating = False
* * * * Application.DisplayAlerts = False
* * * * Sheet4.Range("A1:K82").Copy
* * * * Sheet4.Range("A1").PasteSpecial xlPasteValues
* * * * With Sheet1.Range("A1:G90").Validation
* * * * * * .Delete
* * * * End With
* * * * Sheet1.Range("A14:G90").Copy
* * * * Sheet1.Range("A14").PasteSpecial xlPasteValues
* * * * Application.CutCopyMode = False
* * * * Range("I:V").Delete
* * * * Sheets("Cab Quantities").Delete

* * * * Dim shp As Shape
* * * * Dim myVar As Shapes

* * * * Sheet1.Activate
* * * * Count = ActiveSheet.Shapes.Count

* * * * For i = Count To 1 Step -1
* * * * * * ActiveSheet.Shapes(i).Delete 'myVar(i).Delete
* * * * Next i

* * * * Sheets(Array("Master", "NI Worksheet")).Select
* * * * Sheets("Master").Activate
* * * * Sheets(Array("Master", "NI Worksheet")).Copy
* * * * Set CopyBook = ActiveWorkbook
* * * * Workbooks(Nm).Close
* * * * CopyBook.SaveAs (FlNm)

* * * * Application.ScreenUpdating = True
* * * * Application.DisplayAlerts = True
* * End If
End Sub- Hide quoted text -

- Show quoted text -

I am trying to move the only two worksheets in a workbook to a new
work book to get rid of all macro code. I need to shrink the file
down and eliminating all the modules and forms will be a great start.
So I need to move the sheets to a new workbook and then save the new
workbook as the same name. Any thoughts?

Thanks,
Jay

Below is a sample of a sub that creates a new workbook containing copies of
Sheet1 and Sheet2.

'-----------------------------------------------

Sub NewBookTwoSheets()
Dim intOpens As Integer
Dim objNewBook As Workbook

intOpens = Application.Workbooks.Count
Application.ScreenUpdating = False
Sheets(Array("Sheet1", "Sheet2")).Copy

Set objNewBook = Application.Workbooks(intOpens + 1)
objNewBook.SaveAs ("NewBook.xls")
objNewBook.Close

Application.ScreenUpdating = True
End Sub


'-----------------------------------------------

Steve Yandl




"jlclyde" wrote in message
...
My code is below. Here is what I ahve so far. I am trying to copy a
couple of sheets from a workbook to a new workbook to eliminate all
teh vba code, then save the file as the same name. any help woudl be
appreciated. There are a few other steps I have to go through, the
saving code is at the bottom.

Thanks,
Jay

Sub TearItDown()
Dim Nm As String
Dim FlNm As String
Dim Bk As Workbook
Set Bk = ActiveWorkbook
Nm = Bk.Name
FlNm = Bk.FullName
If ActiveWorkbook.Name = "New Item Master.xls" Then
MsgBox "You are not allowed to delete" & vbCrLf & _
" anything from this master." & vbCrLf & _
"Please save file with a new" & vbCrLf & _
"item number first"
Exit Sub
Else
Range("A5").Select
Sheet1.Range("F4") = Sheet1.Range("F4").Value * 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheet4.Range("A1:K82").Copy
Sheet4.Range("A1").PasteSpecial xlPasteValues
With Sheet1.Range("A1:G90").Validation
.Delete
End With
Sheet1.Range("A14:G90").Copy
Sheet1.Range("A14").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("I:V").Delete
Sheets("Cab Quantities").Delete

Dim shp As Shape
Dim myVar As Shapes

Sheet1.Activate
Count = ActiveSheet.Shapes.Count

For i = Count To 1 Step -1
ActiveSheet.Shapes(i).Delete 'myVar(i).Delete
Next i

Sheets(Array("Master", "NI Worksheet")).Select
Sheets("Master").Activate
Sheets(Array("Master", "NI Worksheet")).Copy
Set CopyBook = ActiveWorkbook
Workbooks(Nm).Close
CopyBook.SaveAs (FlNm)

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub