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

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
wow that works a dream. thanks a million, now its time to learn and understand what I have just copied and pasted lol
 
Upvote 0
Sorry i have a different issue now. Everytime i use the command button it gets smaller and smaller
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,908
Members
448,532
Latest member
9Kimo3

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
Back
Top