VBA – Copy rows to a new workbook based on a cell value

[Testsubject]

Hi

I'm new to VBA, still learning the ropes. Please can I get some assistance and would appreciate help with the below code.

1. The macro runs but copies the same row of data to row 3 in the destination workbook (TEST1), instead of copying it to the next row based on the last row that contains data.
2. If Cell A17 = 7710 on that sheet, it needs to go to sheet 1 in the destination workbook ; If cell A17 = 3810 goes to sheet 2.
3. This needs to work for any number of worksheets present in the active workbook.

----------------------------------------------------------------------------------------------------------------

Sub copyrow()
Dim MyBook As Workbook, newBook As Workbook
Dim FileNm As String
Dim WS As Worksheet
Dim wsCopy As Worksheet

Set MyBook = ThisWorkbook

FileNm = ThisWorkbook.Path & "\" & "TEST1.xls"
Set newBook = Workbooks.Add

With newBook
MyBook.Sheets("(1)").Range("A15", "L15").Copy
newBook.Sheets("Sheet1").Rows("1").PasteSpecial xlPasteAll

For Each WS In Worksheets
With WS.Range("A16", "L17").Copy
newBook.Sheets("Sheet1").Rows("3").PasteSpecial xlPasteValues

End With
Next
'Save new wb with XLS extension
.SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=False

.Close Savechanges:=False
End With

End Sub

----------------------------------------------------------------------------------------------------------------