Delete and copy cells to another sheet



I'm pretty new with macros on Excel. I have a macro that when the user delete
the content of any value between the range of B10:B500 do the following
1.Message box asking if they are sure to delete.
2.If yes is selected,
a. Create one last new row on sheet2.
b. Cut the name to be deleted from Sheet1.
c. Paste the name deleted on the (column F, last new row on
d. Exit from macro.
3. If No is selected, exit from macro.

My macro code is below but I feel that I missing something or I'm doing
something wrong:

Private Sub Exits()
Dim rng As Range
Dim lasrow As Cell
Set rng = Sheets("Headcount as of April-2007").Range("B10:B500")
If rng Is Delete Then
Answer = MsgBox(Prompt:="Delete this name?", Buttons:=vbYesNo +
If Answer = vbYes Then
lastrow = Sheets("EXIT - 2007").UsedRange.Rows.Count
Selection.Insert Shift:=xlDown
Cells(lastrow - 1, 1).Select
Range(ActiveCell, ActiveCell.Offset(0, lastcolumn)).Select
Selection.AutoFill Destination:=Range(ActiveCell,
ActiveCell.Offset(1, lastcolumn)), Type:=xlFillDefault
With rng
.Paste Destination:=Sheets("EXIT - 2007").Range(6, Rows(lastrow))
End With
End If
End Sub

Any help will be appreciated and thanks in advance.




Try this:

The best solution would be to put a button on the menu bar to activate
the macro. I did write it first using the Worksheet_Change event, but
Target didn't always have the contents of the deletion. So I tried to
intercept the delete key, and this works, but it affects any other
workbook opened at the same time.

With the latter in mind...

(If you just want to run the macro manually, leave this section out.)
In the ThisDocument code module paste the following.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Returns the Delete key to normal
Application.OnKey "{Del}"
End Sub

Private Sub workbook_Open()
'Intercepts the Delete Key and runs the macro MoveName
Application.OnKey "{Del}", "module1.MoveName"
End Sub

Add a module, and in Module1 add the following:

Private Sub MoveName()

Dim Rng As Range
Dim Rng2 As Range
Dim TestRng As Range

Dim Lastrow As Integer
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet

'Change the names of the Worksheets if necessary
Set Sheet1 = ActiveWorkbook.Sheets(1)
Set Sheet2 = ActiveWorkbook.Sheets(2)
'Define a range for B
Set Rng = Sheet1.Range("B10:B500")
'Define the range for the current cursor location.
Set Rng2 = Sheet1.Range(ActiveCell.Address)
'If the cell is already empty, end macro.
If Rng2.Value = "" Then Exit Sub

'Define object
Set TestRng = Intersect(Rng, Rng2)

If Not TestRng Is Nothing Then
Answer = MsgBox(Prompt:="Delete this name?", Buttons:=vbYesNo +
If Answer = vbYes Then
'Last row used in sheet 2.
Lastrow = Sheet2.UsedRange.Rows.Count

'Paste in Column 6, one past last row
Sheet2.Paste Destination:=Sheet2.Cells(Lastrow + 1, 6)
End If
'If this wasn't in the desired column, it's a normal delete
End If

End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question