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

[Mokhan58]

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;

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

 

[mumps]

Try this macro on a copy of your file:

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]

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]

My apologies. I missed a line. Try:

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]

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

 

[Mokhan58]

Sorry i have a different issue now. Everytime i use the command button it gets smaller and smaller

 

[mumps]

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.

 

[Mokhan58]

Thanks again. Will give that a go in morning.