VBA Speed up Copy and paste

[hajiali]

Need help to updating below code where copy and paste option to speed up. Let me know if I need to clear any part of the code. Any information is greatly appreciated.

LRStar = ActiveSheet.Range("L1")
For i = 2 To LRStar
LRSft = ActiveSheet.Range("J1")
    If LRSft + LRStar > 4001 Then
            MsgBox "THIS WILL EXCEED THE AMOUNT OF DATA THE TOOL ACCEPTS.", vbOKOnly, "IMPORT EXCEEDED"
            Exit Sub
    End If
    Application.EnableEvents = False
    
        If Cells(i, "L") = 1 Then
            Cells(i, "N").Copy
               Application.EnableEvents = False
                Range("B" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "P").Copy
                Range("A" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "V").Copy
                Range("C" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "X").Copy
                Range("D" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Cells(LRSft, "G").Value = ans
         End If
Next
    For i = 2 To LRStar
    LRSft = ActiveSheet.Range("J1")
        If Cells(i, "Y") = 1 Then
            Cells(i, "N").Copy
               Application.EnableEvents = False
                Range("A" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "P").Copy
                Range("B" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "S").Copy
                Range("C" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "AM").Copy
                Range("U" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Cells(LRSft, "G").Value = ans
         End If
Next

I have also tried

    If Cells(i, "L") = 1 Then
            Application.EnableEvents = False
            Cells(LRSft, "B").Value = Cells(i, "N")
            Cells(LRSft, "A").Value = Cells(i, "P")
            Cells(LRSft, "C").Value = Cells(i, "V")
            Cells(LRSft, "D").Value = Cells(i, "X")
            Cells(LRSft, "G").Value = ans
     End If

 

[skillilea]

try adding

Application.ScreenUpdating = False

...your code

Application.ScreenUpdating = true

 

[hajiali]

try adding

Application.ScreenUpdating = False

...your code

Application.ScreenUpdating = true

I have tried the Screen updating where right before the coping and pasting and seems like its not taking effect. I will not be able to add it before all my code as the pasting is in a Loop to the next cell.

Application.ScreenUpdating = False
            Cells(i, "N").Copy
               Application.EnableEvents = False
                Range("A" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "P").Copy
                Range("B" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "S").Copy
                Range("C" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Cells(i, "AM").Copy
                Range("U" & LRSft).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Cells(LRSft, "G").Value = ans
Application.ScreenUpdating = true

 

[skillilea]

Any chance you can post your sheet using XL2BB?

I'd like to see the sample data.