Automation Error/Excel Crashes during Cut Copy mode

[adr0427]

Hello,

After debugging the code I was able to find where the automation error/excel crashes. I believe it is due to the numerous CutCopy modes in the code snippet. How can I make this snippet of code more efficient. I am basically moving a cell from one column to another based on a value. Thank you in advance for the help!

For i = 2 To MLastRow               'Categorizing p, e and m codes to the right columns.
Rsrc = Sheets("Resources Budget").Cells(i, "A").Value
    For j = 2 To MLastRow1
    If Rsrc = Sheets("Rsrccodes").Cells(j, "G").Value And Sheets("Rsrccodes").Cells(j, "F").Value <> "29910099" Then
    Sheets("Resources Budget").Activate
    Sheets("Resources Budget").Range(Cells(i, "A"), Cells(i, "G")).Copy
    Sheets("Budget Upload").Activate
    Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "A"), Cells((MLastRow2 + i), "G")).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        If InStr(Sheets("Rsrccodes").Cells(j, "F").Value, "2B04") > 0 Then
            Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Cut
            Sheets("Budget Upload").Cells((MLastRow2 + i), "J").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            'Below attempts not working, going blank in Column J :(
            'Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "G"), Cells((MLastRow2 + i), "G")).Value = Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "J"), Cells((MLastRow2 + i), "J")).Value
            'Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Value = Sheets("Budget Upload").Cells((MLastRow2 + i), "J").Value
 
        Else
            Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Cut
            Sheets("Budget Upload").Cells((MLastRow2 + i), "N").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
    ElseIf Rsrc = Sheets("Rsrccodes").Cells(j, "G").Value And Sheets("Rsrccodes").Cells(j, "F").Value = "29910099" Then
    Sheets("Resources Budget").Activate
    Sheets("Resources Budget").Range(Cells(i, "A"), Cells(i, "G")).Copy
    Sheets("Budget Upload").Activate
    Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "A"), Cells((MLastRow2 + i), "G")).Select
    ActiveSheet.Paste
    Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Cut
    Sheets("Budget Upload").Cells((MLastRow2 + i), "K").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
    Next j
    Application.CutCopyMode = False
    
Next i

 

[johnnyL]

You have a bunch of 'Select's and 'Activate's in there. Try replacing the code you provided with the following to see if that helps you out:

For i = 2 To MLastRow               'Categorizing p, e and m codes to the right columns.
Rsrc = Sheets("Resources Budget").Cells(i, "A").Value
    For j = 2 To MLastRow1
    If Rsrc = Sheets("Rsrccodes").Cells(j, "G").Value And Sheets("Rsrccodes").Cells(j, "F").Value <> "29910099" Then
    Sheets("Resources Budget").Range(Cells(i, "A"), Cells(i, "G")).Copy Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "A"), Cells((MLastRow2 + i), "G"))
    Application.CutCopyMode = False
        If InStr(Sheets("Rsrccodes").Cells(j, "F").Value, "2B04") > 0 Then
        Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Cut Sheets("Budget Upload").Cells((MLastRow2 + i), "J")
            Application.CutCopyMode = False
            'Below attempts not working, going blank in Column J :(
            'Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "G"), Cells((MLastRow2 + i), "G")).Value = Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "J"), Cells((MLastRow2 + i), "J")).Value
            'Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Value = Sheets("Budget Upload").Cells((MLastRow2 + i), "J").Value
 
        Else
        Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Cut Sheets("Budget Upload").Cells((MLastRow2 + i), "N")
            Application.CutCopyMode = False
        End If
    ElseIf Rsrc = Sheets("Rsrccodes").Cells(j, "G").Value And Sheets("Rsrccodes").Cells(j, "F").Value = "29910099" Then
    Sheets("Resources Budget").Range(Cells(i, "A"), Cells(i, "G")).Copy Sheets("Budget Upload").Range(Cells((MLastRow2 + i), "A"), Cells((MLastRow2 + i), "G"))
    Sheets("Budget Upload").Cells((MLastRow2 + i), "G").Cut Sheets("Budget Upload").Cells((MLastRow2 + i), "K")
    Application.CutCopyMode = False
    End If
    Next j
    Application.CutCopyMode = False
    
Next i

I have not tested this, but I think I got it right as far as the replacements I did. Let us know how it goes.