Mix paste values and paste formulas in a new Workbook.

[Rickinnocal]

Good day, I have a Command button on a workbook that creates a new workbook and copies data from the old workbook to it. The new workbook, which is based on a workbook supplied to me by the client, is then sent to my client.

Currently, all the cells in the new workbook are populated by :

    wsPaste.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    wsPaste.Range("A1").PasteSpecial xlPasteFormats
    wsPaste.Range("A1").PasteSpecial xlPasteColumnWidths

However, my client has complained. Some of the cells in his workbook contain simple formulae along the lines of "=A3*A4" but in the version I'm sending him that cell contains the result of A3*A4, not the formula, so if he makes any changes to my data, they don't recalculate.

How can I change what I'm doing so that the cells (hundreds of them) that I want to paste as just values do paste that way, but certain cells - just a couple of dozen or so - remain as formulas?

Thanks in advance.

 

[Joe4]

OK, it took me a little while of messing around with it, but I think I got it working.
Something like this:

Sub MyCopyMacro()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim lCell As String
    Dim aCell As String
    Dim cell As Range
    Dim frm As String
    Dim find1 As Long
    Dim find2 As Long
   
    Application.ScreenUpdating = False
   
'   Set workbook variables
    Windows("TestCopyBook.xlsm").Activate
    Set wb1 = ActiveWorkbook
    Windows("TestPasteBook.xlsx").Activate
    Set wb2 = ActiveWorkbook
   
'   Find last cell with data on Copy workbook
    wb1.Activate
    Sheets("Sheet1").Activate
    lCell = Range("A1").SpecialCells(xlLastCell).Address(0, 0)

'   Loop through all cells on wb1
    For Each cell In Range("A1:" & lCell)
        frm = cell.Formula
'       Find where equal sign is in formula
        find1 = InStr(frm, "=")
'       Find where the ! sign is in the formula
        find2 = InStr(frm, "!")
'       Determine if it is a formula
        If find1 = 1 Then
'           Determine if formula references other sheets
            If find2 > 1 Then
'               Copy and paste hard-coded value to same cell on other wb
                wb2.Sheets("Sheet1").Range(cell.Address) = cell.Value
            Else
'               Copy formula
                cell.Copy wb2.Sheets("Sheet1").Range(cell.Address)
            End If
        Else
'           Copy value
            wb2.Sheets("Sheet1").Range(cell.Address) = cell.Value
        End If
       
    Next cell

    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!"
   
End Sub

You will probably just need to adjust the workbook and worksheet names.

 

[Rickinnocal]

I cannot think of a good way to do that.

The only way I can think of is to link through each cell, one at a time, and try to determine which ones access other sheets, and which ones don't, and the either copy the formula or value for each one individually.

Thanks.

I'm thinking I might go back to the beginning.

Instead of copying sheets from the source workbook to a newly created workbook, maybe it would be better to have a command button in the source workbook open a pre-existing workbook that already has all the formatting and 'same sheet' formulas in it, and then just copy blocks of data from the source workbook to the destination workbook and then save the destination book with a new name.

Like this - (pseudo code)

Open workbook "clean efile"
copy me.sheets.(Ship).cells(a10:f20) workbook,"clean efile".sheets.(Ship).cells(b3:g13)
copy me.sheets.(Sample).cells(a10:f20) workbook,"clean efile",sheets.(Sample).cells(b3:g13)
copy me.sheets.(Lab).cells(a1:c3) workbook,"clean efile",sheets.(Lab).cells(c3:h5)
Save workbook "clean efile.xlsm" As "Titanic efile.xlsm"

Richard

 

[Rickinnocal]

OK, it took me a little while of messing around with it, but I think I got it working.
Something like this:

Sub MyCopyMacro()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim lCell As String
    Dim aCell As String
    Dim cell As Range
    Dim frm As String
    Dim find1 As Long
    Dim find2 As Long
  
    Application.ScreenUpdating = False
  
'   Set workbook variables
    Windows("TestCopyBook.xlsm").Activate
    Set wb1 = ActiveWorkbook
    Windows("TestPasteBook.xlsx").Activate
    Set wb2 = ActiveWorkbook
  
'   Find last cell with data on Copy workbook
    wb1.Activate
    Sheets("Sheet1").Activate
    lCell = Range("A1").SpecialCells(xlLastCell).Address(0, 0)

'   Loop through all cells on wb1
    For Each cell In Range("A1:" & lCell)
        frm = cell.Formula
'       Find where equal sign is in formula
        find1 = InStr(frm, "=")
'       Find where the ! sign is in the formula
        find2 = InStr(frm, "!")
'       Determine if it is a formula
        If find1 = 1 Then
'           Determine if formula references other sheets
            If find2 > 1 Then
'               Copy and paste hard-coded value to same cell on other wb
                wb2.Sheets("Sheet1").Range(cell.Address) = cell.Value
            Else
'               Copy formula
                cell.Copy wb2.Sheets("Sheet1").Range(cell.Address)
            End If
        Else
'           Copy value
            wb2.Sheets("Sheet1").Range(cell.Address) = cell.Value
        End If
      
    Next cell

    Application.ScreenUpdating = True
  
    MsgBox "Macro complete!"
  
End Sub

You will probably just need to adjust the workbook and worksheet names.

Thanks, I actually saw this reply after I posted my last post.

I'll look at this, thanks for the help.