How to copy and paste faster? - excel

Question

I copy data from "database" and paste it to another sheet.
Macro takes the names from the list in Sheet1 and looks for matches in Sheet2.
When the match is found it is copying a specific cell.
I have a macro for each person on the list so I have five macros doing the same thing so maybe that why it takes so much time (around three minutes).
Is there any way to make it faster?
Sub CopySalesMan1()
Dim lastrow As Long, erow As Long
lastrow = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("Sheet2").Cells(i, 25).Value = Worksheets("Sheet1").Cells(6, 12).Value Then
Worksheets("Sheet2").Cells(i, 2).Copy
erow = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row
Worksheets("Sheet1").Cells(erow + 1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 25).Copy
Worksheets("Sheet1").Cells(erow + 1, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 3).Copy
Worksheets("Sheet1").Cells(erow + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 4).Copy
Worksheets("Sheet1").Cells(erow + 1, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 5).Copy
Worksheets("Sheet1").Cells(erow + 1, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 6).Copy
Worksheets("Sheet1").Cells(erow + 1, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").Cells(i, 21).Copy
Worksheets("Sheet1").Cells(erow + 1, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next i
End Sub
And the macro calling for every salesman in the list
Sub All()
If Worksheets("Sheet1").Range("L7").Value <> "" Then Call CopySalesMan2
If Worksheets("Sheet1").Range("L8").Value <> "" Then Call CopySalesMan3
If Worksheets("Sheet1").Range("L9").Value <> "" Then Call CopySalesMan4
If Worksheets("Sheet1").Range("L10").Value <> "" Then Call CopySalesMan5
End Sub
Sheet1
Sheet2 (database)

Answer 1

I got the solution:
as braX said .value = .value will be better option
Sub CopySalesMan()
Application.ScreenUpdating = False
Dim XlWkSht As Worksheet, sVal As String, lRow As Long, i As Long, r As Long
Set XlWkSht = Worksheets("Sheet1")
lRow = XlWkSht.Range("D" & XlWkSht.Rows.Count).End(xlUp).Row
For i = 6 To 10
If XlWkSht.Range("L" & i).Value <> "" Then
sVal = XlWkSht.Range("L" & i).Value
With Worksheets("Sheet2")
For r = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
If .Range("Y" & r).Value2 = sVal Then
lRow = lRow + 1
XlWkSht.Range("B" & lRow).Value = .Range("B" & r).Value
XlWkSht.Range("C" & lRow).Value = .Range("Y" & r).Value
XlWkSht.Range("D" & lRow).Value = .Range("C" & r).Value
XlWkSht.Range("E" & lRow).Value = .Range("D" & r).Value
XlWkSht.Range("F" & lRow).Value = .Range("E" & r).Value
XlWkSht.Range("G" & lRow).Value = .Range("F" & r).Value
XlWkSht.Range("H" & lRow).Value = .Range("U" & r).Value
End If
Next r
End With
End If
Next
Application.ScreenUpdating = True
End Sub