Copy for Backup Purpose.

  • Thread starter Thread starter Michael168
  • Start date Start date
M

Michael168

Hi, A Happy New Year Greetings to everybody here.

I hope someone here can help me for this task.
I have a file say "Data.xls" which has 25 sheets under different names.
I like to copy all the 25 sheets of "Data.xls" to a new file say
"Backup.xls" which contain only the values excluding all the formulas
and macros.

Any kind help is appreciated.
Thank you.

Michael
 
Michael,

Sub testit()
Dim wkbSource As Workbook, wkbDest As Workbook, wks As Worksheet
Dim blnFirstWks As Boolean

Set wkbSource = Workbooks.Open("C:\data.xls")

blnFirstWks = True
For Each wks In wkbSource.Worksheets
If blnFirstWks Then
wks.Copy
Set wkbDest = ActiveWorkbook
blnFirstWks = False
Else
wks.Copy After:=wkbDest.Worksheets(wkbDest.Worksheets.Count)
End If
With wkbDest.Worksheets(wkbDest.Worksheets.Count).Cells
.Copy
.PasteSpecial Paste:=xlValues
.Cells(1, 1).Select
End With
Next
Application.CutCopyMode = False

wkbDest.SaveAs "C:\Backup.xls"

wkbSource.Close False
wkbDest.Close False
End Sub

Rob
 
Believe Rob's excellent approach will leave code in Sheet Modules. If this
is a problem for you, then
Here is some code previously posted by Jim Rech that could be used to remove
that code after you create the workbook with Rob's code.

http://groups.google.com/groups?threadm=e3uxzQP0BHA.2228@tkmsftngp07

''Needs a reference to the VB Extensibility library set
'Removes from active workbook all:
''Regular modules
''Class modules
''Userforms
''Code in sheet and workbook modules
''Non built-in references
''Excel 4 macro sheets
''Dialog sheets
Sub RemoveAllCode()
Dim VBComp As Object, AllComp As Object, ThisProj As Object
Dim ThisRef As Reference, WS As Worksheet, DLG As DialogSheet
Set ThisProj = ActiveWorkbook.VBProject
Set AllComp = ThisProj.VBComponents
For Each VBComp In AllComp
With VBComp
Select Case .Type
Case vbext_ct_StdModule, vbext_ct_ClassModule, _
vbext_ct_MSForm
AllComp.Remove VBComp
Case vbext_ct_Document
.CodeModule.DeleteLines 1, .CodeModule.CountOfLines
End Select
End With
Next
For Each ThisRef In ThisProj.References
If Not ThisRef.BuiltIn Then ThisProj.References.Remove ThisRef
Next
Application.DisplayAlerts = False
For Each WS In Excel4MacroSheets
WS.Delete
Next
For Each DLG In DialogSheets
DLG.Delete
Next
End Sub


--
Regards,
Tom Ogilvy

Rob van Gelder said:
Michael,

Sub testit()
Dim wkbSource As Workbook, wkbDest As Workbook, wks As Worksheet
Dim blnFirstWks As Boolean

Set wkbSource = Workbooks.Open("C:\data.xls")

blnFirstWks = True
For Each wks In wkbSource.Worksheets
If blnFirstWks Then
wks.Copy
Set wkbDest = ActiveWorkbook
blnFirstWks = False
Else
wks.Copy After:=wkbDest.Worksheets(wkbDest.Worksheets.Count)
End If
With wkbDest.Worksheets(wkbDest.Worksheets.Count).Cells
.Copy
.PasteSpecial Paste:=xlValues
.Cells(1, 1).Select
End With
Next
Application.CutCopyMode = False

wkbDest.SaveAs "C:\Backup.xls"

wkbSource.Close False
wkbDest.Close False
End Sub

Rob
Click to expand...
 
Thank you to the two gentlemen, Rob van Gelder and Tom Ogilvy, fo
helping.

Regards,
Michae
 
Back
Top