VBA to Move Sheets and save

[jlclyde]

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

 

[Shane Devenshire]

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

 

[jlclyde]

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










- 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

 

[jlclyde]

I figured it out and thought I would post just in case others are
trying to move sheets and eliminate code. You ahve to save the old
workbook as a new name and then you can save the new workbook as the
old name. I also cleaned up the code a little bit so it is easier to
read.

Thanks,
Jay

Sub TearItDown()
Dim Nm As String, FlNm As String
Dim Bk As Workbook
Dim shp As Shape
Dim myVar As Shapes

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
Sheet1.Range("F4") = Sheet1.Range("F4").Value * 1
With Sheet4
.Range("A1:K82").Copy
.Range("A1").PasteSpecial xlPasteValues
End With

With Sheet1
.Range("A5").Select
.Range("A1:G90").Validation.Delete
.Range("A14:G90").Copy
.Range("A14").PasteSpecial xlPasteValues
.Range("I:V").Delete
Count = .Shapes.Count
End With

Application.CutCopyMode = False
Sheets("Cab Quantities").Delete

For i = Count To 1 Step -1
ActiveSheet.Shapes(i).Delete 'myVar(i).Delete
Next i
ActiveWorkbook.SaveAs ("G:\Masters\Test.xls")
Sheets(Array("Master", "NI Worksheet")).Copy

ActiveWorkbook.SaveAs (FlNm)
Workbooks("Test.xls").Close savechanges:=False

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