Move rows to other sheets using a command button

[NeedExclHlp]

I have a workbook with multiple worksheets and want to create a command button that moves rows in one sheet to another.

In the “Master” worksheet, if “Column U” has an “X” in it, I want to move the entire row to the next empty row in “Scrap” worksheet and delete the original row in the “Master” worksheet.

Both worksheets have the same 28 columns with the same headings.

Is this possible?

 

[JLGWhiz]

To attach to button, click Developer, Insert and choose button from Form Controls tool box. When you add the button to the sheet, the 'Assign Macro' dialog box should appear. Click this macro name and then click OK. The macro will now run when you click the command button. The macro is to be copied to your standard code module 1.

Sub moveToScrap()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Master")
Set sh2 = Sheets("Scrap")
sh1.UsedRange.AutoFilter 21, "X", xlOr, "x"
sh1.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy sh2.Cells(Rows.Count, 1).End(xlUp)(2)
sh1.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
sh1.AutoFilterMode = False
End Sub

 

[Michaels]

Yes, its possible. Try this on sample workbook first.

Sub Cut_Paste_DeleteRow_If_X()


    Dim ws As Worksheet, ws2 As Worksheet
    Dim LR As Long, LR2 As Long
    Dim DataRange As Range, C As Range, rngG As Range

    Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Worksheets("Master")
    Set ws2 = ThisWorkbook.Worksheets("Scrap")

    LR = ws.Cells(ws.Rows.Count, 21).End(xlUp).Row
    LR2 = ws2.Cells(ws.Rows.Count, 21).End(xlUp).Row + 1
    Set DataRange = ws.Range("U1:U" & LR)

    For Each C In DataRange
        If C.Value = "x" Then
            If rngG Is Nothing Then Set rngG = Range(C, C.End(xlToRight))
            Set rngG = Union(rngG, Range(C, C.End(xlToRight)))
        End If
    Next C

    rngG.Copy
    ws2.Range("U" & LR2).PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    ws.Activate
    For x = LR To 1 Step -1
        If Cells(x, 21).Value = "x" Then
            Rows(x).Delete
        End If
    Next x

    Application.ScreenUpdating = True
End Sub