View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Walt[_3_] Walt[_3_] is offline
external usenet poster
 
Posts: 48
Default copy sheets in workbook to new workbook

Hi Ctech,

The problem is he
For Each Sht In Worksheets
Sht.Select
Sht.Cells.Select
Selection.Copy
cWbk.Sheets.Add '<<<<<< THIS STEP CANCELS THE CUTCOPYMODE
ActiveSheet.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Next

Any worksheet addition should be done before the copy.

I've sketched out the following which I hope will work for you:
Sub CopyWB_ValOnly()
Dim tWbk As Workbook, cWbk As Workbook, Sht As Integer
On Error GoTo CopyWB_ValOnlyERROR
Set tWbk = ActiveWorkbook
'CREATE WORKBOOK WITH ONE WORKSHEET
Set cWbk = Workbooks.Add(xlWBATWorksheet)
For Sht = 1 To tWbk.Worksheets.Count 'ALIGN WORKSHEETS COUNT
With cWbk
If .Worksheets.Count < Sht Then
.Worksheets.Add
ActiveSheet.Move _
after:=Worksheets(.Worksheets.Count)
End If
End With
Next
For Sht = 1 To tWbk.Worksheets.Count 'COPY WS NAMES AND VALUES
With cWbk
.Worksheets(Sht).Name = tWbk.Worksheets(Sht).Name
tWbk.Worksheets(Sht).Cells.Copy
.Worksheets(Sht).Cells(1, 1).PasteSpecial _
Paste:=xlValues, Operation:=xlNone
End With
Next
cWbk.SaveAs Filename:="X:\Users\Shared\GENERAL\Christian" & _
"S\05.11.23 - Budget Uploading LBUD3\BFR\Copy of file.xls"
Set tWbk = Nothing: Set cWbk = Nothing
Exit Sub
CopyWB_ValOnlyERROR:
cWbk.Close SAVECHANGES:=False
Set tWbk = Nothing: Set cWbk = Nothing
MsgBox "Error in CopyWB_ValOnly routine"
End Sub

Best Regards,
Walt Weber