Sub List1()
    Dim ipsheet As Worksheet
    Dim pnsheet As Worksheet
    Dim lastrow As Long
    Dim x As Long
    Dim outputRow As Long

    
    Set ipsheet = ThisWorkbook.Sheets("Name")
    Set pnsheet = ThisWorkbook.Sheets("Pasport")


    lastrow = ipsheet.Cells(ipsheet.Rows.Count, 1).End(xlUp).Row


    outputRow = 16


    For x = 1 To lastrow

        If ipsheet.Cells(x, 1).Value <> "" Then

            pnsheet.Cells(outputRow, 2).Value = ipsheet.Cells(x, 1).Value
            
            outputRow = outputRow + 1
        End If
    Next x
End Sub