How to add rows added to a table to a new sheet

[batel19]

The attached code copies from sheet 1 to sheet 3 all the values that are equal to the value "Moshe" from the table in sheet 1. If rows are added in sheet 1, I want to add only the new rows if they meet the condition

I want to add only the line I marked in yellow
The first line with the entry Moshe has already been added before

I hope that is clear enough .


Sub Moshe()

Dim xRg As Range

Dim xCell As Range

Dim A As Long

Dim B As Long

Dim C As Long

A = Worksheets("sheet1").UsedRange.Rows.Count

B = Worksheets("sheet3").UsedRange.Rows.Count

If B = 1 Then

If Application.WorksheetFunction.CountA(Worksheets("sheet3").UsedRange) = 0 Then B = 1

End If

Set xRg = Worksheets("sheet1").Range("A2:A" & A)

On Error Resume Next

Application.ScreenUpdating = False

For C = 1 To xRg.Count

If CStr(xRg(C).Cells(1, 3)) = "Moshe" Then

xRg(C).EntireRow.Copy Destination:=Worksheets("sheet3").Range("A" & B + 1)

B = B + 1

End If



Next

Application.ScreenUpdating = True


End Sub

 

[kevin9999]

I note you have 365. If it was me, I would simply use the functions available in 365 to automatically update your sheet 3 whenever new rows are added to your table in sheet 1 - as long as they are unique (i.e. not added before). Just change "Table1" to whatever your table is called.

Book1
	A	B	C	D
1	Last_Name	First_Name	Amount	Type
2	ron	moshe	3	Dog
3	ddi	moshe	3	Elephant
4
Sheet3

Cell Formulas
Range	Formula
A2:D3	A2	=UNIQUE(FILTER(Table1,Table1[First_Name]="moshe",""))
Dynamic array formulas.

 

[batel19]

Thanks for the response, but it's not enough I want to do in VB

 

[kevin9999]

I want to do in VB

As you wish. From what little I can see on your image, it looks like you have the columns running right to left so I don't know how the following code will work out for you. I've set the autofilter to field 3 (which is C when going from right to left) and you'll need to change the table name in the code from "Table1" to whatever you've called it. If it doesn't work then I must confess it's beyond my experience working with sheets with an Arabic style layout.
Good Luck!

Option Explicit
Option Compare Text
Sub batel()
    Dim ws1 As Worksheet, ws3 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws3 = Worksheets("Sheet3")
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 3, "moshe"
        If ws1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws3.Range("D" & ws3.Cells(Rows.Count, 1).End(xlUp).Row).Offset(1)
        End If
    End With
    ws1.ListObjects("Table1").AutoFilter.ShowAllData
    ws3.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
End Sub

 

[batel19]

thanks but its get an eror :"Subscript out of range " also you can expline me what is A1 and table 1 in the code ?

 

[kevin9999]

I assumed (wrongly?) that your image was a table, now I suspect it's just a range. A1 is cell A1 - column A and row 1. Telling me the error message without indicating the line the error occurs on isn't too helpful. As I explained in my previous post, I don't have any experience with Arabic style sheet layouts, so I'll step out of this thread now & hope that someone else will be able to help you.
You can help others by providing a sample of your sheet using the XL2BB add in, or better still, sharing your file via Dropbox, Google Drive or similar file sharing platform. Good luck and best wishes.