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

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
11,718
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
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
11,718
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
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
11,718
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,642
Messages
5,832,840
Members
430,172
Latest member
SandyCrack

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