Your current code has problem when the user enters the number greater than the List rows. e.g. 22
To Sheet2 code module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long, tbl1 As ListObject, tbl2 As ListObject
If Target.Address(0, 0) <> "O17" Then Exit Sub
Set tbl1 = ThisWorkbook.Sheets("Sheet1").ListObjects("table1")
Set tbl2 = ThisWorkbook.Sheets("sheet3").ListObjects("table2")
If tbl2.ListRows.Count Then tbl2.DataBodyRange.Delete
x = Target.Value
If x < 1 Then Exit Sub
x = Application.Min(x, tbl1.ListRows.Count)
tbl1.ListRows(tbl1.ListRows.Count).Range.Offset(-x + 1).Resize(x).Copy tbl2.Range(2, 1)
End Sub
Bookmarks