Help needed with small issues in function

[sersan]

Hi,

I need to find a way to copy and paste the entire content of a sheet as values. I can do it with a selected range, but is it possible to do for the entire sheet?
Then, need to know the best way to delete entire selected rows and columns.
Finally, I want to delete some sheets (Sheet1, Sheet2...). The problem is when those sheets don't exists anymore, and the error occurs. What is the best way to handling with this error?

This thread is in follow of this one:
http://www.vbaexpress.com/forum/showthread.php?t=41959

Thanks!

[Paul_Hossler]

I'd start with something like this

[VBA]
Option Explicit
Sub CopySheet()
Dim rSrc As Range
Set rSrc = Worksheets("Sheet1").UsedRange
rSrc.Copy

Worksheets("sheet2").Select
Worksheets("sheet2").Range(rSrc.Cells(1, 1).Address).Select

Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Sub DeleteEntireRow()

If Not TypeOf Selection Is Range Then Exit Sub
Selection.EntireRow.Delete
End Sub
Sub DeleteEntireColumn()

If Not TypeOf Selection Is Range Then Exit Sub
Selection.EntireColumn.Delete
End Sub

Sub DeleteSomeSheets()
Application.DisplayAlerts = False
On Error Resume Next

Worksheets("sheet2").Delete
Worksheets("sheet3").Delete
Worksheets("sheet99999").Delete
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
[/VBA]

Paul

[sersan]

Hi!

I've try the code to copy and past as values, but didn't work, giving always an error in the Selection.PasteSpecial line.
Anyway, my idea was to copy and paste the same sheet, not into another sheet as values.

I have the code already done, but maybe it could be optimized. Here's the code:
[vba]
Sub Save_CostSheet2()
Dim csFileName As String
Dim csTitle As String
Dim opChoose As String
Dim wbExisting As String
Dim wbOpenNumber As Integer
Dim wbCurrent As Workbook
Dim wbNew As Workbook
Dim stOpenNumber As Integer
Dim stCurrent As Worksheet
Dim stNew As Worksheet
Const stName As String = "Test"
'Name of the cost sheet title.
csTitle = InputBox("Please Specify the Title for this Cost Sheet", "New Cost Sheet")
If csTitle = "False" Or csTitle = "" Then
Exit Sub
End If
'Set the location of the starting point.
Set wbCurrent = ActiveWorkbook
Set stCurrent = ActiveSheet
'Count original number of open workbooks.
wbOpenNumber = Application.Workbooks.Count
'Choose to open file or to create a new one.
Repeat_Question:
opChoose = InputBox("Do you Want to Save to an Existing File <1> or to Save to a New File <2>", "Select Option")
If opChoose = "False" Or opChoose = "" Then
Exit Sub
End If
Select Case Val(opChoose):
Case 0:
Exit Sub

Case 1:
wbExisting = Application.GetOpenFilename(filefilter:="Microsoft Excel Workbook (*.xls), *.xls", Title:="Open Workbook")
If wbExisting = "False" Or wbExisting = "" Then
Exit Sub
End If
Workbooks.Open Filename:=wbExisting

'Set the new sheet as the latest member of the workbook.
Set wbNew = Application.Workbooks(wbOpenNumber + 1)

'Copy the new sheet After the first sheet of the workbook opened or created.
stOpenNumber = wbNew.Sheets.Count
stCurrent.Copy After:=wbNew.Sheets(stOpenNumber)

'Copy and paste sheet range as values only.
Set stNew = ActiveSheet
stNew.Name = stName & Str(stOpenNumber)
stNew.Range("A1:Z150").Copy
stNew.Range("A1:Z150").PasteSpecial xlPasteValues

'Delete objects, rows and columns.
On Error Resume Next
stNew.DrawingObjects.Visible = True
stNew.DrawingObjects.Delete
On Error GoTo 0
stNew.Range("A2:A34").EntireRow.Delete
stNew.Range("P1:Z1").EntireColumn.Delete

'Set the title of the new sheet and save the file.
wbNew.Sheets(1).Range("A1").Value = csTitle
stNew.Range("A1").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs
Application.DisplayAlerts = True

Case 2:
'Get the name of the new file
csFileName = Application.GetSaveAsFilename(filefilter:="Microsoft Excel Workbook (*.xls), *.xls", Title:="Save Workbook As")
If csFileName = "False" Or csFileName = "" Then
Exit Sub
End If

'Set the new sheet as the latest member of the workbook.
Application.Workbooks.Add
Set wbNew = Application.Workbooks(wbOpenNumber + 1)

'Copy the new sheet before the first sheet of the workbook opened or created.
stCurrent.Copy Before:=wbNew.Sheets(1)

'Copy and paste sheet range as values only.
Set stNew = ActiveSheet
stNew.Name = stName
stNew.Range("A1:Z150").Copy
stNew.Range("A1:Z150").PasteSpecial xlPasteValues

'Delete objects, rows and columns.
On Error Resume Next
stNew.DrawingObjects.Visible = True
stNew.DrawingObjects.Delete
On Error GoTo 0
stNew.Range("A2:A34").EntireRow.Delete
stNew.Range("P1:Z1").EntireColumn.Delete

'Delete all empty sheets.
Application.DisplayAlerts = False
On Error Resume Next
wbNew.Sheets("Sheet1").Delete
wbNew.Sheets("Sheet2").Delete
wbNew.Sheets("Sheet3").Delete
wbNew.Sheets("Sheet4").Delete
wbNew.Sheets("Sheet5").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Set the title of the new sheet and save the file.
wbNew.Sheets(1).Range("A1").Value = csTitle
stNew.Range("A1").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs csFileName, FileFormat:=xlExcel8
Application.DisplayAlerts = True

Case Else:
GoTo Repeat_Question
End Select
End Sub
[/vba]

Please guys, just remember, I'm not a programmer, this is just me trying to make something to improve my work...