Function Translit(ByVal txt As String) As String
     iRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
     iTranslit = Array("", "a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "jj", "k", _
                       "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "h", "c", "ch", _
                       "sh", "zch", "''", "'y", "'", "eh", "ju", "ja")
     For iCount% =  1  To  33 
         txt = Replace(txt, Mid(iRussian$, iCount%,  1 ), iTranslit(iCount%), , , vbTextCompare)
     Next
     Translit$ = txt
End Function

Function Translit(ByVal txt As String) As String
     iBefore$ = "1234567890"
     iThen = Array("", "", "", "", "", "", "", "", "", "",)
     For iCount% =  1  To  10 
         txt = Replace(txt, Mid(iBefore$, iCount%,  1 ), iThen(iCount%), , , vbTextCompare)
     Next
     Then$ = txt
End Function

With ActiveSheet
    .Rows("последняя строка:2000 строк вверх от последней").Select
    Selection.Cut
    Sheets.Add After:=Sheets(Sheets.Count)
    Последний лист в книге.Paste
    End With

.Rows("последняя строка:2000 строк вверх от последней").Select
on error goto "конец"

Sub razdelit_list()
Dim iLastRow As Long, x As Long, n As Long
Application.ScreenUpdating = False
    With ActiveSheet
        iLastRow = .Cells(Rows.Count,  1 ).End(xlUp).Row
        x = Application.InputBox("Укажите количество строк в блоке для переноса на другие листы", "Выбираем размер блока", Type:= 1 )
        n = iLastRow / x
        For i =  1  To n -  1 
            Range(.Cells(x +  1 ,  1 ), .Cells(x + x,  1 )).EntireRow.Cut
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Paste
            Range(.Cells(x +  1 ,  1 ), .Cells(x + x,  1 )).EntireRow.Delete
            iLastRow = .Cells(Rows.Count,  1 ).End(xlUp).Row
        Next
    End With
Application.ScreenUpdating = True
End Sub

Sub Макрос1()
Dim iLastRow As Long, x As Long, n As Long 
Application.ScreenUpdating = False 
    With Sheets("Лист1") 
        iLastRow = .Cells(Rows.Count,  1 ).End(xlUp).Row 
        x = Application.InputBox("Укажите количество строк в блоке для переноса на другие листы", "Выбираем размер блока", Type:= 1 )
        n = iLastRow / x 
        For i =  1  To n 
            Range(.Cells(x +  1 ,  1 ), .Cells(x + x,  1 )).EntireRow.Cut 
            Sheets.Add After:=Sheets(Sheets.Count) 
            ActiveSheet.Paste 
            Range(.Cells(x +  1 ,  1 ), .Cells(x + x,  1 )).EntireRow.Delete 
        Next
    End With
Application.ScreenUpdating = True
End Sub