PDA

View Full Version : How can I copy 2 sheets and Paste everything but the Formulas



Kal-El
03-03-2017, 12:12 PM
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
03-03-2017, 01:07 PM
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
03-03-2017, 06:35 PM
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
03-03-2017, 07:13 PM
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
03-04-2017, 05:49 PM
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
03-06-2017, 08:39 AM
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
03-06-2017, 09:05 AM
What did you get when you just used the code in Post #4 without changes except the sheet names?

Kal-El
03-06-2017, 09:46 AM
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
03-06-2017, 10:33 AM
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
03-06-2017, 05:00 PM
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
03-06-2017, 06:51 PM
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
03-07-2017, 07:17 AM
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