Copy Worksheet Not the Macros

[micheldevon]

I'm looking to copy a worksheet from one Workbook to a new workbook,
but I don't want the Macros, Code or Forms to copy. Only the Worksheet
Data. Any ideas?

This is the code I'm currently using to create the new workbook.


Sub CopySheets()

Application.ScreenUpdating = False

Dim ws As Worksheet, fileDate As String, bFirst As Boolean, wbkNew
As Workbook

Application.DisplayAlerts = False

actwb = ActiveWorkbook.Name
fileDate = Format(Date, "mm-dd-yy")

filenm = (fileDate) & ".xls" 'assign the new workbooks names

bFirst = True
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "CHIP RESPONSE LOG", "DocuGrab", "CPC PROD LOG",
"MODIFIER_GRID", "TCR PASS", "TCR DENIAL"
'these are the sheets names which shouldn't be copied
Case Else
If bFirst = True Then
ws.Copy
Set wbkNew = ActiveWorkbook
Set VBComps = ActiveWorkbook.VBProject.VBComponents

bFirst = False
'with the first sheet copied, create a new workbook
Else
ws.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
'add subsequent copies to the new workbook
With ActiveWorkbook.VBProject
End If
End Select
Next ws
wbkNew.SaveAs Filename:=(fileDate) & ".xls"
wbkNew.Close

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

 

[Jim Rech]

This is code I use to clear out all programmatic items from the active
workbook. You might try running it after you've created your new workbook.


''Needs a reference to the VB Extensibility library set:
'' In the VBE select Tools, References and check:
'' "Microsoft Visual Basic for Applications Extensibility 5.3"


'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()
'XL2K+:
Dim VBComp As VBComponent, AllComp As VBComponents, ThisProj As
VBProject
'XL97 & XL2K:
'Dim VBComp As Object, AllComp As Object, ThisProj As Object
Dim ThisRef As Reference, WS As Worksheet, DLG As DialogSheet
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
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
Else
MsgBox "Switch to the workbook to remove code from"
End If
End Sub

--
Jim
| I'm looking to copy a worksheet from one Workbook to a new workbook,
| but I don't want the Macros, Code or Forms to copy. Only the Worksheet
| Data. Any ideas?
|
| This is the code I'm currently using to create the new workbook.
|
|
| Sub CopySheets()
|
| Application.ScreenUpdating = False
|
| Dim ws As Worksheet, fileDate As String, bFirst As Boolean, wbkNew
| As Workbook
|
| Application.DisplayAlerts = False
|
| actwb = ActiveWorkbook.Name
| fileDate = Format(Date, "mm-dd-yy")
|
| filenm = (fileDate) & ".xls" 'assign the new workbooks names
|
| bFirst = True
| For Each ws In ThisWorkbook.Worksheets
| Select Case ws.Name
| Case "CHIP RESPONSE LOG", "DocuGrab", "CPC PROD LOG",
| "MODIFIER_GRID", "TCR PASS", "TCR DENIAL"
| 'these are the sheets names which shouldn't be copied
| Case Else
| If bFirst = True Then
| ws.Copy
| Set wbkNew = ActiveWorkbook
| Set VBComps = ActiveWorkbook.VBProject.VBComponents
|
| bFirst = False
| 'with the first sheet copied, create a new workbook
| Else
| ws.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
| 'add subsequent copies to the new workbook
| With ActiveWorkbook.VBProject
| End If
| End Select
| Next ws
| wbkNew.SaveAs Filename:=(fileDate) & ".xls"
| wbkNew.Close
|
| Application.DisplayAlerts = True
| Application.ScreenUpdating = True
| End Sub
|

 

[Yngve]

hi
try this
dir and path you have change.

Sub copy_ActiveSheet()

ActiveSheet.Cells.Copy
Workbooks.Add Template:="Arbeidsbok"
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False


Dim wb As Workbook
Dim strdate As String
strdate = Format(Now, "dd-mm-yy")

Set wb = ActiveWorkbook
With wb

.SaveAs "c:\" & strdate & ".xls"

End With


End Sub

regards yngve