PDA

View Full Version : Save some sheets with name



clem
10-11-2007, 05:50 AM
Hello !

I?d like to save with date only some filled sheets of an Excel Workbook.
I mean my workbook has 15 sheets. If I fill 3 of them I?d like to save them on a separate workbook named with today date. The new workbook has to be copied only with formats and values, but not with formulas.

Anyone can help me with a macro ?

Thank you in advance and best regards,!

Oorang
10-11-2007, 07:03 AM
:welcome:
You will need to tell us what you cells need to filled out for the worksheet to be considered complete :)

clem
10-12-2007, 02:58 AM
Hello Aaron,

Thank you for reply.
Complete file is composed by 15 sheets which I fill every day with lots of data. At the end of working day I need to save only filled sheets and they must be saved only with formats and values, not with formulas linked to original file.
The first cell of each sheets to be filled in is Range A11 which could be used as reference: if A11> than ?0?.
Hope this is what you want to know.
Thank you and best regards,
Clem :doh:

mdmackillop
10-12-2007, 07:10 AM
Hi Clem,
Welcome to VBAX

Option Explicit

Sub CopyBook()
Dim sh As Worksheet
Sheets.Copy
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.Range("A11") <> "" Then
sh.UsedRange.Copy
sh.UsedRange.PasteSpecial xlValues
Else
sh.Delete
End If
Next
Application.CutCopyMode = False
Application.DisplayAlerts = True
ActiveWorkbook.SaveAs "C:\AAA\Test" & Format(Date, "yymmdd") & ".xls"
ActiveWorkbook.Close
End Sub

Oorang
10-12-2007, 08:22 AM
Hi Clem,
Mad Mac beat me to the post, but I had already finished this, so I will post. It's a little long, but I tried to make it modular so it would be easy to maintain.
Option Explicit

Public Sub ExportCompletedWorksheets()
'--------------------------------------------------------------------------------
' Procedure : ExportCompletedWorksheets
' Date : 10/12/2007
' Purpose : Detect which worksheets are exportable and save.
'--------------------------------------------------------------------------------
Const lngSheet1_c As Long = 1
Const lngColumnA As Long = 1
Const lngColumnB As Long = 2
Const strIncomplete_c As String = "Not Complete"
Const strCompleted_c As String = "Completed"
Const strDlmtr_c As String = " - "
Const lngMaxShtNameLen_c As Long = 31
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim wsCrnt As Excel.Worksheet
Dim wbExport As New Excel.Workbook
Dim wsSummary As Excel.Worksheet
Dim blnHasErr As Boolean
On Error GoTo Err_Hnd
Set wb = Excel.ActiveWorkbook
Set wbExport = BuildExportWorkbook
Set wsSummary = wbExport.Worksheets(lngSheet1_c)
For Each ws In wb.Worksheets
wsSummary.Cells(ws.Index, lngColumnA).Value = ws.Name
If IsWorksheetCompleted(ws) Then
wsSummary.Cells(ws.Index, lngColumnB).Value = strCompleted_c
Set wsCrnt = wbExport.Worksheets.Add(After:=wbExport.Worksheets(wbExport.Worksheets.Coun t))
wsCrnt.Range(ws.UsedRange.Address).Value = ws.UsedRange.Value
wsCrnt.Name = VBA.Right$(ws.Name & strDlmtr_c & VBA.Date$, lngMaxShtNameLen_c)
Else
wsSummary.Cells(ws.Index, lngColumnB).Value = strIncomplete_c
End If
Next
wsSummary.Activate
Exit_Proc:
On Error Resume Next
If blnHasErr Then
wbExport.Close False
End If
Exit Sub
Err_Hnd:
blnHasErr = True
VBA.MsgBox "Error " & VBA.Err.Number & " (" & VBA.Err.Description & ") in procedure ExporCompletedWorksheets of Module Module1"
Resume Exit_Proc
End Sub
Private Function IsWorksheetCompleted(ws As Excel.Worksheet) As Boolean
'--------------------------------------------------------------------------------
' Procedure : IsWorksheetCompleted
' Date : 10/12/2007
' Purpose : Determine if a given worksheet has been filled out.
'--------------------------------------------------------------------------------
Const strRangeA11_c As String = "$A$11"
Const lngRangeA11MinVal_c As Long = 0
Dim strRngVal As String
On Error GoTo Err_Hnd
strRngVal = ws.Range(strRangeA11_c).Value
If IsNumeric(strRngVal) Then
If CDbl(strRngVal) > lngRangeA11MinVal_c Then
IsWorksheetCompleted = True
End If
End If
Exit Function
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & " (" & VBA.Err.Description & ") in procedure IsWorksheetCompleted of Module Module1"
End Function

Private Function BuildExportWorkbook() As Excel.Workbook
'--------------------------------------------------------------------------------
' Procedure : BuildExportWorkbook
' Date : 10/12/2007
' Purpose : Builds worksheet for your export.
'--------------------------------------------------------------------------------
Const lngOneSheet_c As Long = 1
Dim wbResult As Excel.Workbook
Dim lngOrglShtsInNewWBVal As Long
On Error GoTo Err_Hnd
lngOrglShtsInNewWBVal = Excel.Application.SheetsInNewWorkbook
Excel.Application.SheetsInNewWorkbook = lngOneSheet_c
Set wbResult = Excel.Workbooks.Add
wbResult.Worksheets(lngOneSheet_c).Name = "Summary"
Set BuildExportWorkbook = wbResult
Exit_Proc:
On Error Resume Next
Excel.Application.SheetsInNewWorkbook = lngOrglShtsInNewWBVal
Exit Function
Err_Hnd:
VBA.MsgBox "Error " & VBA.Err.Number & " (" & VBA.Err.Description & ") in procedure BuildExportWorkbook of Module Module1"
Resume Exit_Proc
End Function

clem
10-14-2007, 11:30 PM
Thank you Mdmackillop and thank you Aaron for your replies. Let me try today and I let you know.

Best regards,
Clem

clem
10-23-2007, 01:35 AM
Sorry to reply you so late.
Your help has been great ! Thank you very much indeed.
Iwould like to ask you one more thing:
with macroes you suggested I create a new file. How can I cancel from the new file all macroes recorded in ThisWorkbook ? I mean all the events coming Before Printing, Before Closing and so on.

Thank you for your precious help.

Best regards,
Clem

Bob Phillips
10-23-2007, 01:39 AM
What do you mean exactly by Cancel them?