copy rows to multiple sheets

  • Thread starter Thread starter pvkutty
  • Start date Start date
P

pvkutty

I got this macro from you disc table . My question is can I add diff
worksheet with diff names and add correspondng rows to that sheet.
exp. I have EXIT, ALH,EASY three sheets and I need that corresponding
rows to copy to these sheets when I etner Q column.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastExitRow As Long, Cell As Range
For Each Cell In Target
If Cell.Column = 17 Then ' 17 = Column Q
If UCase(Cell.Value) = "EXIT" Then
With Worksheets("EXIT")
LastExitRow = .Cells(Rows.Count, "A").End(xlUp).Row
Cell.EntireRow.Copy .Cells(LastExitRow - (.Cells( _
LastExitRow, "A").Value <> ""), "A")
Cell.EntireRow.Delete
End With
End If
End If
Next
End Sub
 
Welcome. Try the below

Select the sheet tab which you want to work with. Right click the sheet tab
and click on 'View Code'. This will launch VBE. Paste the below code to the
right blank portion. Get back to to workbook and try out.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastExitRow As Long, ws As Worksheet
If Target.Column = 17 And Target.Text <> "" Then
On Error Resume Next
Set ws = Worksheets(Target.Text)
On Error GoTo 0
If Not ws Is Nothing Then
With Worksheets(Target.Text)
Application.EnableEvents = False
LastExitRow = .Cells(Rows.Count, "A").End(xlUp).Row
Target.EntireRow.Copy .Range("A" & LastExitRow + 1)
Target.EntireRow.Delete
Application.EnableEvents = True
End With
End If
End If

End Sub
 
Back
Top