Macro to delete rows after copying and pasting

[Wigman86]

Hello all

The below Macro copy and pastes rows from my "Data" sheet to "Sheet 2" and " Sheet 3" based on the criteria below. After this macro copies and pastes i then want it to delete the same rows it copy and pasted from the original "Data" tab. Any help would be greatly appreciated.



'Copy and Paste rows that have A and B'




Private Sub CommandButton1_Click()


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual




a = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row


For i = 11 To a


If (Worksheets("Data").Cells(i, 9).Value = "A" Or Worksheets("Data").Cells(i, 9).Value = "B" Then


Worksheets("Data").Rows(i).Copy
Worksheets("Sheet 2").Activate


b = Worksheets("Sheet 2").Cells(Rows.Count, 1).End(xlUp).Row


Worksheets("Sheet 2").Cells(b + 1, 1).Select


ActiveSheet.Paste


Worksheets("Data").Activate




End If


'Copy and Paste rows that have C'




If Worksheets("Data").Cells(i, 38).Value = "C" Then


Worksheets("Data").Rows(i).Copy
Worksheets("Sheet 3").Activate


b = Worksheets("Sheet 3").Cells(Rows.Count, 1).End(xlUp).Row


Worksheets("Sheet 3").Cells(b + 1, 1).Select


ActiveSheet.Paste


Worksheets("Data").Activate


End If




Next


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


MsgBox "Done!"


End Sub

 

[alansidman]

try this modified code. Note this is untested.

Option Explicit


Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Sheet 2")
    Set s3 = Sheets("Sheet 3")
    a = s1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = a To 11 Step -1
        b = s2.Cells(Rows.Count, 1).End(xlUp).Row
        If s1.Cells(i, 9) = "A" Or s1.Cells(i, 9) = "B" Then
            s1.Rows(i).Copy s2.Cells(b + 1, 1)
            s1.Cells(i, 9).EntireRow.Delete
        End If
        'Copy and Paste rows that have C'
        If s1.Cells(i, 38).Value = "C" Then
            b = s3.Cells(Rows.Count, 1).End(xlUp).Row
            s1.Rows(i).Copy s3.Cells(b + 1, 1)
            s1.Cells(i, 38).EntireRow.Delete
        End If
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Done!"
End Sub

 

[Wigman86]

try this modified code. Note this is untested.

Option Explicit


Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Sheet 2")
    Set s3 = Sheets("Sheet 3")
    [B]a =[/B] s1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = a To 11 Step -1
        b = s2.Cells(Rows.Count, 1).End(xlUp).Row
        If s1.Cells(i, 9) = "A" Or s1.Cells(i, 9) = "B" Then
            s1.Rows(i).Copy s2.Cells(b + 1, 1)
            s1.Cells(i, 9).EntireRow.Delete
        End If
        'Copy and Paste rows that have C'
        If s1.Cells(i, 38).Value = "C" Then
            b = s3.Cells(Rows.Count, 1).End(xlUp).Row
            s1.Rows(i).Copy s3.Cells(b + 1, 1)
            s1.Cells(i, 38).EntireRow.Delete
        End If
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Done!"
End Sub

Thank you for your help.

When i run this code it highlights the below and gives me the error message "Variable not defined"

a = s1.Cells(Rows.Count, 1).End(xlUp).Row

Do you know how i can fix this?

Thanks

 

[alansidman]

Add this line of code near the top of the code. This was caused by adding the Option Explicit at the top of the code which won't allow code to run if all variables are not dimensioned.

Dim a as long, b as long