Copy workbook with values and format 1

[indupriya9]

I have a requirement to copy the workbook into a new workbook. I cannot use the savecopyas method as it copies all the macros as well. I want to copy values and formats from each worksheet into worksheets in a different workbook.

The error I get is 'object required'

The code I wrote so far is as follows:

Sub fSaveWorkbookData()  'Executed when F6 is pressed'
                         
    Dim oName As String
    
    Application.DisplayAlerts = False
    oName = "ProgressData"
    Set SrcBook = ThisWorkbook
    Set NewBook = Workbooks.Add
    SrcBook.Activate
   
    'j = 1
    For i = 1 To Worksheets.Count
        With SourceWB
       .Worksheets(i).Copy <<<<< Error here <<<<<
      With .Worksheets(i)
          .UsedRange.Copy
          .Range("A1").PasteSpecial Paste:=xlValues
          Set NewWB = Workbooks.Add
          .Move Before:=NewWB.Sheets(i)
      End With
    End With
    
    'ActiveSheet.Cells.Copy
    'NewBook.Activate
    'If j <= 3 Then
       'NewBook.Worksheets(j).Range("A1").PasteSpecial xlPasteValues
    'Else
       'NewBook.Worksheets.Add
       'NewBook.Worksheets(j).Range("A1").PasteSpecial xlPasteValues
    'End If
    'j = j + 1
    SrcBook.Activate
    Next i
    NewBook.Activate
    oName = "c:\" + oName + ".xls"
    ActiveWorkbook.Close savechanges:=True, Filename:=oName
    MsgBox (oName + " has been saved to 'c:' directory")
    Application.DisplayAlerts = True
    
End Sub

Can anyone please tell me what I am doing wrong?

Regards
ip

 

[Bong]

You initialize SrcBook: Set SrcBook = ThisWorkbook but you use SourceWB: With SourceWB.

_________________
Bob Rashkin

 

[PHV]

Tip: use the Option Explicit instruction.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[indupriya9]

Hi Bob

Thanks for your quick reply. I have changed that to SRCBook. Now I get a 'Subscript out of range error' at line

.Move Before:=NewWB.Sheets(i)

What am I doing wrong?

 

[PHV]

I STRONGLY suggest you follow my previous advice.
Your code:
Set [!]NewBook[/!] = Workbooks.Add
vs
.Move Before:=[!]NewWB[/!].Sheets(i)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[indupriya9]

Hi PHV

I tried to use Option Explicit. But I am not sure where to use it. I have included within the sub.

I am actually trying to modify earlier exisitng code, so I don't know the basics of VBA. WOuld you mind telling me what the purpose of Option explicit is and where I should use it?

Thanks for all your help.

Regards
ip

 

[PHV]

Put this instruction in the Declarations section of your module as the very first line.
Then put the cursor inside the Explicit word in your code and press the F1 key.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[indupriya9]

Thanks PHV

Now I know the use of Options Explicit. And I think my approach to copy worksheets is wrong because for each sheet it is creating a new workbook whereas I need all worksheets of the source workbook to be copied into the new workbook with only the values and formats.

Any ideas on how to do this?

 

[PHV]

Have a look at the PasteSpecial method.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[indupriya9]

Hi

Here is what I have changed the code to. But I get the error 'Subscript out of range' What am I doing wrong?

Sub fSaveWorkbookData()  'Executed when F6 is pressed'
                         'made redundant
    
    Dim oName As String
    
    Application.DisplayAlerts = False
    oName = "QualProgressData"
    Set SrcBook = ThisWorkbook
    Set NewBook = Workbooks.Add
    SrcBook.Activate
   
    'j = 1
    For i = 4 To Worksheets.Count
            
    ActiveSheet.Cells.Copy
    NewBook.Activate
    NewBook.Worksheets(i).Range("A1").PasteSpecial xlPasteValues  <<<<< Error line >>>>>>
    SrcBook.Activate
    Next i
    NewBook.Activate
    oName = "c:\tats\save\" + oName + ".xls"
    ActiveWorkbook.Close savechanges:=True, Filename:=oName
    MsgBox (oName + " has been saved to 'c:\tats\save' directory")
    Application.DisplayAlerts = True
    
End Sub

 

[PHV]

A starting point:

Sub fSaveWorkbookData()    'Executed when F6 is pressed'
Dim SrcBook As Workbook, NewBook As Workbook
Dim i As Integer
Dim oName As String

Application.DisplayAlerts = False
Set SrcBook = ThisWorkbook ' perhaps ActiveWorkbook is more suited
Set NewBook = Workbooks.Add
With SrcBook
  For i = 1 To .Worksheets.Count
    .Worksheets(i).Copy After:=NewBook.Sheets(NewBook.Sheets.Count)
  Next i
End With
oName = "c:\ProgressData.xls"
NewBook.Close SaveChanges:=True, Filename:=oName
MsgBox oName & " has been saved to 'c:' directory"
Application.DisplayAlerts = True
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[indupriya9]

Hi PHV

Thanks for your ammended code. It works fine. But what I am getting is a copy of all the formulae and formats. But I donot want to copy formulas as each cell has formulae and this is increasing the size of the new workbook.

Is there a way to copy the formats and values but not the formulae?

Thanks
ip

 

[PHV]

The OP mentioned macros, not formulae ...
What about this ?

Sub fSaveWorkbookData()    'Executed when F6 is pressed'
Dim SrcBook As Workbook, NewBook As Workbook
Dim i As Integer
Dim oName As String

Application.DisplayAlerts = False
Set SrcBook = ThisWorkbook ' perhaps ActiveWorkbook is more suited
Set NewBook = Workbooks.Add
With SrcBook
  For i = 1 To .Worksheets.Count
    .Worksheets(i).Copy After:=NewBook.Sheets(NewBook.Sheets.Count)
    NewBook.Sheets(NewBook.Sheets.Count).UsedRange.Value = NewBook.Sheets(NewBook.Sheets.Count).UsedRange.Value
  Next i
End With
oName = "c:\ProgressData.xls"
NewBook.Close SaveChanges:=True, Filename:=oName
MsgBox oName & " has been saved to 'c:' directory"
Application.DisplayAlerts = True
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[indupriya9]

PHV you are a star!

Wonderful. That works perfectly. I have learnt a lot today. I am giving you two stars.

Thanks once again
ip