How to move row contents to another sheet based on criteria

< Back to Search results

 Category: [Excel]  Demo Available 

How to move row contents to another sheet based on criteria




The user has a sheet that they would like to move the contents the row to another sheet based on the cell percentage in column 'J' = 100% and the button at the top of the page pressed.

A sample spreadsheet has been attached.






Place the following code on a Standard Module and assign it to the shape you have on the Asbestos sheet by right clicking on the shape and choose Assign Macro and select the macro CopyToArchive and click OK.

Sub CopyToArchive()
Dim sws As Worksheet, dws As Worksheet
Dim slr As Long
Application.ScreenUpdating = False

Set sws = Sheets("Asbestos")
Set dws = Sheets("Asbestos-Archive")
slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
sws.AutoFilterMode = False
With sws.Rows(3)
    .AutoFilter Field:=10, Criteria1:="100%"
    If sws.Range("A3:A" & slr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        sws.Range("A4:AG" & slr).SpecialCells(xlCellTypeVisible).Copy
        dws.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
        sws.Range("A4:AG" & slr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
End With
sws.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

If you don't want to delete the rows after copying them to Archive sheet, remove the following line from the code...




An alternative method which would be faster if there are many rows of data that need moving.

Assign this to the button:

Sub ArchiveData()
    Dim x, y(), i As Long, ii As Long, iii As Long
    With Sheets("Asbestos").Cells(3, 1).CurrentRegion
        x = .Value
        For i = 2 To UBound(x, 1)
            If x(i, 10) = 1 Then
                ii = ii + 1: ReDim Preserve y(1 To UBound(x, 2), 1 To ii)
                For iii = 1 To UBound(y, 1)
                    y(iii, ii) = x(i, iii)
                x(i, 1) = ""
            End If
        .Value = x
    End With
    With Sheets("Asbestos-Archive")
        i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(i, 1).Resize(UBound(y, 2), UBound(y, 1)) = Application.Transpose(y)
        .Columns(11).ColumnWidth = 10
        .Rows(4).Resize(ii).RowHeight = 32.25
    End With
End Sub


Obtained from the OzGrid Help Forum.

Solution provided by sktneer and KjBox.


See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets


See also:

How to use a code to display the current date based on certain criteria
How to use VBA to change zero value to blank value based on criteria in other columns
How to add digit or replace last digit in string based on criteria
How to find and write cells based on criteria


Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.


stars (0 Reviews)