How can I copy 2 sheets and Paste everything but the Formulas

[Kal-El]

I am trying to use this piece below but need it to A copy 2 sheets to the temp workbook, but paste everything but the formulas.

The problem I seem to be running into is that when it pastes into the new XLS I lose all the Values b/c they are based off formulas from other sheets.

Thanks in advance

'Copy the active sheet to a new temporarily workbook.
  With ActiveSheet
    .Copy
    stFileName = .Range("C5").Value
  End With
 
  stAttachment = stPath & "\" & stFileName & ".xls"
 
  'Save and close the temporarily workbook.
  With ActiveWorkbook
    .SaveAs stAttachment
    .Close
  End With

[ipisors]

Sub CopySheet1()
Dim wsOrig As Worksheet, wsTemp As Worksheet, wsNew As Worksheet, wbNew As Workbook, rng As Range


Dim stPath As String 'assign this a value, I don't see that in your code, nor is it in mine *********
                     'so assign it one before trying to use this code                       *********


Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets(1)
Set wsOrig = ThisWorkbook.Worksheets("Sheet1")
'change this to suit, and never use ActiveSheet, Active, Activate, etc in VBA code,         *********
'nor depend on anything like that. It's a terrible practice, as coding practices            *********
'in VBA go                                                                                  *********


Set rng = wsOrig.UsedRange
rng.Copy
wsNew.Range("A1").PasteSpecial (xlPasteValues)
wsNew.Range("A1").PasteSpecial (xlPasteColumnWidths)
wsNew.Range("A1").PasteSpecial (xlPasteFormats)
stPath = stPath & "\" & wsOrig.Range("c5").Value & ".xls"
wbNew.SaveAs stPath, FileFormat:=56
End Sub

[Kal-El]

Thanks, the only issue I am having is that I need

Set wsOrig = ThisWorkbook.Worksheets("Sheet1")

to copy 2 worksheets at once to the same XLS

[jolivanes]

With relevant info lacking, this could be a start.

Sub Macro1()
Dim i As Long
Application.ScreenUpdating = False
    Sheets(Array("Sheet1", "Sheet2")).Copy    'Select
    With ActiveWorkbook
        For i = 1 To 2
            .Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value
        Next i
    End With
Application.ScreenUpdating = True
End Sub

[ipisors]

Thanks, the only issue I am having is that I need

Set wsOrig = ThisWorkbook.Worksheets("Sheet1")

to copy 2 worksheets at once to the same XLS

....so
just
repeat
the
code

set onething=onething
then do stuff

then set onething = another t hing
then do stuff

c'mon man, at least give it some effort, this isn't Freebieville, show some effort on your part

[Kal-El]

Sorry I am new to figuring this out, I tried a few other ways and it wasn't working, I had it working using this below code but it was copying the formulas which was then resulting in blank cells in the new XLS b/c the data associated to the formulas did not exist
" Sheets(Array(Sheet1.Name, Sheet2.Name)).Copy "

With both your help its almost working trying to figure out why the when the 2nd worksheet gets pasted the bottom half is blank but the first few cells of data are populated. the 2 sheets are exactly the same so I am not sure why its not pasting all the data in the 2nd sheet.

Sub Send_Active_Sheet()
 
  Dim stFileName As String
  Dim vaRecipients As Variant
 
  Dim noSession As Object
  Dim noDatabase As Object
  Dim noDocument As Object
  Dim noEmbedObject As Object
  Dim noAttachment As Object
  Dim stAttachment As String
  Dim wsOrig As Worksheet, wsTemp As Worksheet, rng As Range

  Set wsOrig = ThisWorkbook.Worksheets("IN")

 Dim i As Long
    Application.ScreenUpdating = False
    Sheets(Array("IN", "OUT")).Copy 'Select
    With ActiveWorkbook
        For i = 1 To 2
            .Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value
        Next i
                                                            
    
    stAttachment = stPath & "\" & wsOrig.Range("c5").Value & stFileName & ".xls"
    .SaveAs stAttachment, FileFormat:=56
   End With

[jolivanes]

What did you get when you just used the code in Post #4 without changes except the sheet names?

[Kal-El]

It initially pastes everything until it goes through this loop (below) then it deletes the bottom half of the data. but its leaving all the Formulas in the new workbook

For i = 1 To 2
            .Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value
        Next i

[Kal-El]

I managed to resolve the issue, I started from scratch using ipisors suggestions and slowed down a bit . All good now, except now I have a new error for sending the file I made in Domino (which I had working), but will open a new thread on that


Thank you

[ipisors]

I managed to resolve the issue, I started from scratch using ipisors suggestions and slowed down a bit . All good now, except now I have a new error for sending the file I made in Domino (which I had working), but will open a new thread on that


Thank you

Glad you made it work. Sorry, I didn't mean to be harsh.

Good to hear it's working.

[jolivanes]

Good for you.
But personally I don't want to Copy and Paste if not required.
Could you try this and let us know how it worked, or not if it didn't.
Thanks for your cooperation.

Sub Copy_To_New_Book_B()
    Dim i As Long, lr As Long, lc As Long
    Application.ScreenUpdating = False
    Sheets(Array("In", "Out")).Copy    '<---- Check sheet names
        For i = 1 To ActiveWorkbook.Worksheets.Count
           With Sheets(i)
                lr = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
                lc = .Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
                .Range(.Cells(1, 1), .Cells(lr, lc)).Value = .Range(.Cells(1, 1), .Cells(lr, lc)).Value
            End With
        Next i
    Application.ScreenUpdating = True
End Sub

[Kal-El]

Good morning, it works but the second worksheet has no data in it just the table formatting nothing in the cells

Sub Copy_To_New_Book_B()
  Dim i As Long, lr As Long, lc As Long
    
    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets(Array("IN", "OUT")).Copy '<---- Check sheet names
    For i = 1 To ActiveWorkbook.Worksheets.Count
        With Sheets(i)
            lr = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
            lc = .Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
            .Range(.Cells(1, 1), .Cells(lr, lc)).Value = .Range(.Cells(1, 1), .Cells(lr, lc)).Value
        End With
    Next i
    Application.ScreenUpdating = True
End Sub