Code to Cut and Paste

[siarrad]

Hello everyone,

I'm having some trouble getting this code to do what I want. I have an excel spreadsheet with a few tabs. On sheet 1, there are record names in Column A. The names are duplicated from Sheet 1 on to Sheet 2. Sheet 2 has a table of the records and headers that outline four steps, the final step being complete. There is a button that updates the table with a colored block as the records goes through the four steps. The button opens a form that lets you select a record and then select one of the steps, to update table. When you select a record and then select the last step "complete", I want the record's row in Sheet 1 to move to next available row in Sheet 3. Currently the code copies headers from Sheet 1 to Sheet 3.


Sub MoveCells()
Dim rng As Range
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set pasteSheet = Worksheets("Completed")
Set rng = Range("A1").CurrentRegion
Set rng =rng.Offset(1).Resize(rng.Rows.Count - 1)

rng.Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

 

[Yongle]

If you simply want the values try this

replace

Set rng = Range("A1").CurrentRegion
    Set rng =rng.Offset(1).Resize(rng.Rows.Count - 1)
rng.Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues

with

Set rng = ActiveCell.EntireRow
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).EntireRow.Value = Cells(ActiveCell.Row, 1).EntireRow.Value
ActiveCell.EntireRow.Delete

To include the formatting

Set rng = ActiveCell.EntireRow
rng.Copy
With pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
     .PasteSpecial xlPasteFormats
     .PasteSpecial xlPasteValues
End With
ActiveCell.EntireRow.Delete

 

[Yongle]

Oh..
Just spotted that I set the range and did not use it in the code for values only
(the code works but contains a redundant line)

So either

Set rng = ActiveCell.EntireRow
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).EntireRow.Value = Cells([COLOR=#ff0000]rng[/COLOR].Row, 1).EntireRow.Value
[COLOR=#ff0000]rng[/COLOR].EntireRow.Delete

or simply delete the redundant row

pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).EntireRow.Value = Cells(ActiveCell.Row, 1).EntireRow.Value
ActiveCell.EntireRow.Delete