VBA to Move Sheets and save
 

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

VBA to Move Sheets and save
 

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

VBA to Move Sheets and save
 

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

VBA to Move Sheets and save
 

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