cut and paste from excel able to second sheet based on cell value

Mokhan58

New Member
Joined
Feb 8, 2019
Messages
5
hi guys,

I'm new here so please forgive me if I have not posted accurately.

the source is table format.

I'm currently working on some code to copy paste an entire row to archived sheet based on a single column being filled in column I after the table headers from row 8

I have got the code to partially work but it either leaves behind empty rows if i cut or some of the copied data if i copy.
can someone please tell me where im going wrong. Haven't used vba since college 10 years ago so bit rusty

here is code I am using;

Code:
Private Sub CommandButton1_Click()
a = Worksheets("Current Workstack").Cells(Rows.Count, 1).End(xlUp).Row
For i = 8 To a
    If Worksheets("Current workstack").Cells(i, 9).Value <> "" Then
        Worksheets("Current Workstack").Rows(i).Cut
        Worksheets("archived work").Activate
        b = Worksheets("Archived Work").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Archived Work").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Current Workstack").Activate
    
    End If
  
 Next i
 
 For b = 1 To a
 
 If Worksheets("Current workstack").Cells(b, 2) = "" Then
 Worksheets("Current Workstack").Rows(b).EntireRow.Delete
  End If
 Next b
 
 Application.CutCopyMode = False
 
 End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,311
Try this macro on a copy of your file:
Code:
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim a As Long
    a = Worksheets("Current Workstack").Cells(Rows.Count, 1).End(xlUp).Row
    For i = a To 8 Step -1
        With Sheets("Current workstack")
            If .Cells(i, 9).Value <> "" Then
                .Rows(i).EntireRow.Copy Sheets("Archived Work").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Rows(i).EntireRow.Delete
            End If
     Next i
     Application.ScreenUpdating = True
 End Sub
 

Mokhan58

New Member
Joined
Feb 8, 2019
Messages
5
wow that is much shorter than my schoolboy version. one issue though. for some reason it comes back with error saying next without for, when clearly for is present. and if I delete next it shows another error etc
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,311
My apologies. I missed a line. Try:
Code:
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim a As Long
    a = Worksheets("Current Workstack").Cells(Rows.Count, 1).End(xlUp).Row
    For i = a To 8 Step -1
        With Sheets("Current workstack")
            If .Cells(i, 9).Value <> "" Then
                .Rows(i).EntireRow.Copy Sheets("Archived Work").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Rows(i).EntireRow.Delete
            End If
        [COLOR="#FF0000"]End With[/COLOR]
     Next i
     Application.ScreenUpdating = True
 End Sub
 

Mokhan58

New Member
Joined
Feb 8, 2019
Messages
5

ADVERTISEMENT

wow that works a dream. thanks a million, now its time to learn and understand what I have just copied and pasted lol
 

Mokhan58

New Member
Joined
Feb 8, 2019
Messages
5
Sorry i have a different issue now. Everytime i use the command button it gets smaller and smaller
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,311
Instead of a button, insert a shape and assign the macro to it. You can right click on the shape to format it with text, color, etc.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,167
Messages
5,640,539
Members
417,151
Latest member
ChickenTenderer

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top