Excel VBA macro to copy specific rows and delete it

[pourmalla]

Hi to every one;
At first thanks in advance to everyone that read my question, and specially help me to fix my problem.
Here what I want to do:


I have 2 worksheet named Pending & Records.
Column in Pending worksheet: A: Date, B: Delivery To, C: Delivery to office, D: Delivery to Manager, E: Subject, F: Date & G: Letter No.
Column in Records worksheet: A: Date, B: Letter No. & C: Subject.
When entered number in cell G (Letter No.) of Pending worksheet, the below cells copy to specified cells in Records worksheet.



E (Subject) in Pending worksheet sit in C (subject) of Records worksheet.
F (Date) in Pending worksheet sit in A (Date) of Records worksheet.
G (Letter No.) in Pending worksheet sit in B (Letter No.) of Records worksheet.



Deleted the row that copy in Pending worksheet.
Sort the rows in Records worksheet according to Letter No. (Column C).

This is codes that I write for what I want to do (not work good) and some screenshot:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then
If Len(Target.Value) > 0 Then
Dim r As Range
Dim a As String
Dim b As String
b = "sheet3!A" & Sheet1.Cells(1, 9) + 3 & ":C" & Sheet1.Cells(1, 9) + 3
a = "E" & Target.Row & ":G" & Target.Row
Dim r1, r2 As Range
r1 = Sheet1.Range(a)
Sheet2.Range(b).Value = r1
Sheet1.Range(a).EntireRow.Delete
End If
End If
End Sub
18826
18827
18828

[mana]

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rr As Range, r As Range
Dim ws As Worksheet
Dim n As Long

Set rr = Intersect(Target, Columns(6))

If rr Is Nothing Then Exit Sub

Set ws = Sheets("Records")
n = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

Application.EnableEvents = False
For Each r In rr
If r.Value <> "" Then
ws.Cells(n, "B").Value = r.Value
ws.Cells(n, "A").Value = r.Offset(, -2).Value
ws.Cells(n, "C").Value = r.Offset(, -1).Value
n = n + 1
r.EntireRow.Delete
End If
Next

Application.EnableEvents = True

ws.Cells(1).CurrentRegion.Sort Key1:=ws.Columns("C"), order1:=xlAscending, Header:=xlYes

End Sub

[pourmalla]

Dear mana
I don't know how to thanks you.
it's work well. there is small problem. it go when enter date, so change (target, Columns (6)) to 7
but date sit to Letter No. and Date disappear.
I'm working on it and trying to fix it.
many many thanks

[mana]

Sorry.


Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rr As Range, r As Range
Dim ws As Worksheet
Dim n As Long

Set rr = Intersect(Target, Columns("G"))

If rr Is Nothing Then Exit Sub

Set ws = Sheets("Records")
n = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

Application.EnableEvents = False
For Each r In rr
If r.Value <> "" Then
ws.Cells(n, "B").Value = r.Value 'G:Letter No.
ws.Cells(n, "A").Value = r.Offset(, -1).Value 'F;Date
ws.Cells(n, "C").Value = r.Offset(, -2).Value 'E:Subject
n = n + 1
r.EntireRow.Delete
End If
Next

Application.EnableEvents = True

ws.Cells(1).CurrentRegion.Sort Key1:=ws.Columns("C"), order1:=xlAscending, Header:=xlYes

End Sub

[pourmalla]

THANKS THANKS THANKS
IT WORK
LOVE YOU