Copy Workbook but Only Certain Worksheets & Paste Certian Cells as Formulas, Others as Text

[jtd]

Hello, all. First post on this board, would greatly appreciate your input.

Say I have a workbook with the following named worksheets:

Sheet1
Sheet2
DataSheet
Sheet3

I want to create VBA code (button) to make a copy of some of these sheets into a new workbook that has the following characteristics:

In Sheet1 I want to copy only the text & formatting (no formulas) of the sheet.
However in Sheet2, I want to copy the formulas of all the cells except cells A1:B2 and D1:E2 (for these cells, I would like them to be pasted as values into the new workbook).
In Sheet3 I want to paste values of all cells except A1:B2 and D1:E2 (for these cells, I would like them to include formulas).

DataSheet would not be copied into the new file.


Let me know you have any additional questions. Thank you so much.

 

[tweedle]

Welcome;

A gift; below is one way.
There is no error checking (ie if you change sheet names, errors will occur). There are also opportunities to optimize, I'm sure.

Sub MyCopySheets()
    Dim ws
    Dim ThisWB, NewWB As Workbook
    Set ThisWB = ThisWorkbook
    Set NewWB = Workbooks.Add
    Windows.Arrange ArrangeStyle:=xlVertical
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Select Case NewWB.Sheets.Count
    Case Is < 3
        Do Until NewWB.Sheets.Count = 3: NewWB.Sheets.Add After:=NewWB.Sheets(NewWB.Sheets.Count): Loop
    Case Is > 3
        Do Until NewWB.Sheets.Count = 3: NewWB.Sheets(NewWB.Sheets.Count).Delete: Loop
    End Select
    'Sheet1 I want to copy only the text & formatting (no formulas)
    ThisWB.Sheets("Sheet1").UsedRange.Copy
    NewWB.Sheets(1).Activate
    NewWB.Sheets(1).Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                   :=False, Transpose:=False
    NewWB.Sheets(1).Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
    '============================================
    'in Sheet2, I want to copy the formulas of all the cells
    ThisWB.Sheets("Sheet2").UsedRange.Copy
    NewWB.Sheets(2).Activate
    NewWB.Sheets(2).Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                                                                     :=False, Transpose:=False
    NewWB.Sheets(2).Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
    'cells A1:B2 and D1:E2 (for these cells, I would like them to be pasted as values
    ThisWB.Sheets("Sheet2").Range("A1:B2").Copy
    NewWB.Sheets("Sheet2").Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                   :=False, Transpose:=False
    ThisWB.Sheets("Sheet2").Range("D1:E2").Copy
    NewWB.Sheets("Sheet2").Range("D1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                   :=False, Transpose:=False
    '============================================
    'Sheet3 I want to paste values of all cells
    ThisWB.Sheets("Sheet3").UsedRange.Copy
    NewWB.Sheets(3).Activate
    NewWB.Sheets(3).Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                   :=False, Transpose:=False
    NewWB.Sheets(3).Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
    'except A1:B2 and D1:E2 (for these cells, I would like them to include formulas).
    ThisWB.Sheets("Sheet3").Range("A1:B2").Copy
    NewWB.Sheets("Sheet3").Range("A1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                                                                     :=False, Transpose:=False
    ThisWB.Sheets("Sheet3").Range("D1:E2").Copy
    NewWB.Sheets("Sheet3").Activate
    NewWB.Sheets("Sheet3").Range("D1").Activate
    ActiveCell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                                                                     :=False, Transpose:=False
    '============================================

    ThisWB.Sheets("Sheet1").Activate
    ThisWB.Sheets("Sheet1").Range("A1").Select
    NewWB.Sheets("Sheet1").Activate
    NewWB.Sheets(1).Range("A1").Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub