Paste Only Values

[JoeThomas]

Below code copies a range of cells from multiple cells in a workbook to a Master Sheet however, I need it to copy only the values and not the formulas. I've tried a few things like
CopyRng.Copy With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

but that doesn't work.
The actual code I'm talking about is this:

Option Explicit


Sub CopytoSummary()


Dim wks As Worksheet
Dim CopyRng As Range
Dim DestSht As Worksheet
Dim LastFreeColumn As Long
Dim DestRowNo As Byte
Dim c As Range





'below "with" speed up the macro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With





'setting the destination as sheet1 you can use sheet name instead
Set DestSht = Sheet18





'looping through each wks in workbook
For Each wks In ActiveWorkbook.Worksheets

'if wks is different than destination will go through
If wks.Name <> DestSht.Name And wks.Name <> "Template" Then

Set wks = wks

'Select source range
With wks
Set CopyRng = .Range("I2, I3, I13, J13, AD13")
End With



With DestSht

'setting the last free destination column
LastFreeColumn = .Cells(1, 1600).End(xlToLeft).Column + 1
DestRowNo = 1

'Copy each cell to Summary
For Each c In CopyRng
c.Copy .Cells(DestRowNo, LastFreeColumn)
DestRowNo = DestRowNo + 1

Next c


'column width
.Columns(LastFreeColumn).ColumnWidth = 31
End With
End If


Next wks





'set the application back to normal
With Application
.ScreenUpdating = True
.EnableEvents = True
End With





End Sub

 

[MARK858]

In what way does the below not work (I am assuming that your layout looks incorrect in the first post because of not using code tags and it isn't how it appears in your actual code).

    CopyRng.Copy
    With DestSh.Cells(Last + 1, "A")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    End With

 

[MARK858]

Maybe you mean something like....

    For Each c In CopyRng
        Dim LstRw As Long
        LstRw = DestSht.Cells(Rows.Count, "A").End(xlUp).Row
        c.Copy
        With DestSht.Cells(LstRw + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
    Next c

Btw you were also using DestSht in one code and DestSh in the other

 

[JoeThomas]

AM
@MARK858 - thanks for your prompt response. It actually worked with a slight tweak (code below)

AM
Option Explicit


Sub CopytoSummary()


Dim wks As Worksheet
Dim CopyRng As Range
Dim DestSht As Worksheet
Dim LastFreeColumn As Long
Dim DestRowNo As Byte
Dim c As Range

'below "with" speed up the macro​

With Application​

.ScreenUpdating = False​

.EnableEvents = False​

End With​

'setting the destination as sheet1 you can use sheet name instead
Set DestSht = Sheet18





'looping through each wks in workbook

For Each wks In ActiveWorkbook.Worksheets​

​

'if wks is different than destination will go through​

If wks.Name <> DestSht.Name And wks.Name <> "Template" Then​

​

Set wks = wks​

​

'Select source range​

With wks​

Set CopyRng = .Range("I2, I3, I13, J13, AD13")​

End With​

​

With DestSht

' setting the last free destination column​

LastFreeColumn = .Cells(1, 1600).End(xlToLeft).Column + 1​

DestRowNo = 1​

​

​

'Copy each cell to Summary​

For Each c In CopyRng​

c.Copy

With .Cells(DestRowNo, LastFreeColumn)​

DestRowNo = DestRowNo + 1​

.PasteSpecial xlPasteValues​

.PasteSpecial xlPasteFormats​

Application.CutCopyMode = False​

End With

Next c

'column width​

.Columns(LastFreeColumn).ColumnWidth = 31​

End With
End If


Next wks

'set the application back to normal​

With Application​

.ScreenUpdating = True​

.EnableEvents = True​

End With​

End Sub

This pastes the values in columns towards right, can this be customized to paste the values in the rows and downwards? or would this be a question for another thread. Thanks for your help!