Change VBA to paste as values

[thedeadzeds]

Guys, how do i change the below to paste as values only?

Sub Bethan_New_Calls_Service_and_MOT()    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, j As Long
    Set sh1 = Sheets("Audi Service & MOT New Calls")
    Set sh2 = Sheets("All Data")
    
    'Filter New Call
    Sheets("Audi Service & MOT New Calls").Select
    ActiveSheet.ListObjects("Audi_New_SANDM").Range.AutoFilter Field:=4, _
        Criteria1:="New Calls"
    'Filter the relevant Contcode
    ActiveSheet.ListObjects("Audi_New_SANDM").Range.AutoFilter Field:=13, _
        Criteria1:=Array("Kerridge Service", "Kerridge Service & MOT", "Polk Service", _
        "Polk Service & MOT"), Operator:=xlFilterValues
    'Filter by person
    ActiveSheet.ListObjects("Audi_New_SANDM").Range.AutoFilter Field:=16, _
        Criteria1:="Bethan M"
    
    i = 1
    For j = 1 To Rows.Count
        If sh1.Cells(j, 1).EntireRow.Hidden = False Then
            sh1.Cells(j, 1).EntireRow.Copy sh2.Cells(i, 1)
            i = i + 1
            If i = Range("Allocate!e3").Value + 2 Then Exit Sub
        End If
    Next j
End Sub

 

[RoryA]

Change this:

sh1.Cells(j, 1).EntireRow.Copy sh2.Cells(i, 1)

to this:

sh1.Cells(j, 1).EntireRow.Copy
sh2.Cells(i, 1).PasteSpecial xlPasteValues

 

[thedeadzeds]

Thanks for that, works great but runs really slow. Anyway around that?

 

[RoryA]

You could just skip the loop and copy the table:

    ActiveSheet.ListObjects("Audi_New_SANDM").Range.specialcells(xlcelltypevisible).copy
sh2.Cells(1, 1).PasteSpecial xlPasteValues
application.cutcopymode = false

 

[thedeadzeds]

Thank you for that much appreciated. Just out of interest I will eventually have 10 (or more depending on the amount of names) of the same code above for each name in Field 16. So i will run 10 or more separate macros. For each name I change

If i = Range("Allocate!e3").Value + 2 Then Exit Sub

to a new cell as different names will have a different value, ie, copy 25 for Bethan, 30 for Angela etc etc and then Paste all of the data to one sheet below each other. Is there a quicker way around this . Hope this makes sense

 

[RoryA]

If column A on sh2 always has data in it for each row, you could just use:

sh2.Cells(rows.count, 1).End(xlUP).Offset(1).PasteSpecial xlPasteValues

to just paste to the next blank row.

 

[thedeadzeds]

Thank you