Hi Harold

I'm afraid I have not understood the question. Do you want to delete the
rows moved to "3 BIN", delete the values of the specific cells moved or
simply clear the selection?

Regards
Rowan

Optitron wrote:
That worked perfectly. Thank you. Now, how do I get that info to clear
in "3 BIN" before it moves it? Let's say I selected 8 rows and clicked
the button, now I want to replace it with the next 8 rows. Is there
something to add to that code or should I have another button? Here's
the new code after I had to tweek(red) it a little:

Sub THREEBIN()
Dim toWks As Worksheet
Dim actWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iRow As Long
Dim DestCell As Range

Set actWks = ActiveSheet
Set toWks = Worksheets("3 BIN")

Set myRng = Intersect(Selection.EntireRow, actWks.Range("a:a"))

With toWks
If .Cells(.Rows.Count, "A").End(xlUp).Row = 1 Then
Set DestCell = .Cells(1, 1)
Else
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp). _
Offset(7, 0)
End If
End With

With toWks
For Each myCell In myRng.Cells
iRow = myCell.Row
DestCell.Value = actWks.Cells(iRow, "B").Value
DestCell.Offset(0, 1).Value = actWks.Cells(iRow, "C").Value
DestCell.Offset(0, 3).Value = actWks.Cells(iRow, "E").Value
DestCell.Offset(0, 4).Value = actWks.Cells(iRow, "F").Value
DestCell.Offset(0, 22).Value = actWks.Cells(iRow, "M").Value
DestCell.Offset(1, 4).Value = actWks.Cells(iRow, "N").Value
Set DestCell = DestCell.Offset(7, 0)
Application.Goto .Range("a1"), scroll:=True
Next myCell
End With
End Sub

Rowan Drummond Wrote:

Try:

Sub DRMO2()
Dim toWks As Worksheet
Dim actWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iRow As Long
Dim DestCell As Range

Set actWks = ActiveSheet
Set toWks = Worksheets("3 BIN")

Set myRng = Intersect(Selection.EntireRow, actWks.Range("a:a"))

With toWks
If .Cells(.Rows.Count, "A").End(xlUp).Row = 1 Then
Set DestCell = .Cells(1, 1)
Else
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp). _
Offset(5, 0)
End If
End With

With toWks
For Each myCell In myRng.Cells
iRow = myCell.Row
DestCell.Value = actWks.Cells(iRow, "B").Value
DestCell.Offset(0, 1).Value = actWks.Cells(iRow, "C").Value
DestCell.Offset(0, 3).Value = actWks.Cells(iRow, "E").Value
DestCell.Offset(0, 4).Value = actWks.Cells(iRow, "F").Value
DestCell.Offset(0, 5).Value = actWks.Cells(iRow, "M").Value
DestCell.Offset(0, 6).Value = actWks.Cells(iRow, "N").Value
Set DestCell = DestCell.Offset(5, 0)
Application.Goto .Range("a1"), scroll:=True
Next myCell
End With
End Sub

Regards
Rowan