Making a If True Double Loop Copy Special Paste Faster

[Hmerman]

Hello,
Hope you are well.

I have code that looks on Sheet 7 and Sheet 18 for a cells thats values are equal. Then pastes contiguous and non contiguous values in the same row as the equal cell in Sheet 7 to Sheet 18.

It takes a very long time. Can someone please help to make it faster?

<code>
Dim varResponse As String
Dim i As Long, x As Long

varResponse = MsgBox("Transfer Info to Inventory", vbYesNo, "Selection")
​

If varResponse <> vbYes Then Exit Sub
​

Application.ScreenUpdating = False

With Sheet18​

lastLookup = Sheet7.Range("C" & .Rows.Count).End(xlUp).row​

lastrow = .Range("C" & .Rows.Count).End(xlUp).row​

For i = 2 To lastrow​

For x = 2 To lastLookup​

If (Sheet7.Cells(x, 3) = .Cells(i, 3).Value) Then​

Sheet7.Cells(x, 2).Copy​

.Cells(i, 6).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 4).Copy​

.Cells(i, 7).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 8).Copy​

.Cells(i, 8).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 12).Copy​

.Cells(i, 9).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 14).Copy​

.Cells(i, 10).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 15).Copy​

.Cells(i, 11).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 16).Copy​

.Cells(i, 12).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 17).Copy​

.Cells(i, 13).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 18).Copy​

.Cells(i, 14).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 19).Copy​

.Cells(i, 15).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 20).Copy​

.Cells(i, 16).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 21).Copy​

.Cells(i, 17).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 22).Copy​

.Cells(i, 18).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 23).Copy​

.Cells(i, 19).PasteSpecial xlPasteValues​

Sheet7.Cells(x, 24).Copy​

.Cells(i, 20).PasteSpecial xlPasteValues​

End If​

Next​

Next
​

MsgBox "Complete!"


End With
Application.ScreenUpdating = True
</code>

Any advice or suggestion will be helpful.

Regards,
Herman

 

[Fluff]

Glad to help & thanks for the feedback