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:

1. I have 2 worksheet named Pending & Records.
2. Column in Pending worksheet: A: Date, B: Delivery To, C: Delivery to office, D: Delivery to Manager, E: Subject, F: Date & G: Letter No.
3. Column in Records worksheet: A: Date, B: Letter No. & C: Subject.
4. 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.

1. Deleted the row that copy in Pending worksheet.
2. 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

01.jpg
02.jpg
03.jpg

[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