9000개의 전화번호를 4000개씩 나눠서 csv파일 형식으로 저장하는 매크로를 만들고 싶습니다

안녕하세요.

회사업무 중 수많은 연락처에 문자발송 할 일이 있는데

4000개씩 나눠서 csv 파일 형식으로 저장해서 사용해야합니다ㅠㅠ

엑셀 초보라 여기저기 찾아보던 중 기본 형식이 있어서 짜깁기해서 쓰다보니

제가 원하는 매크로가 만들기 어려워서 질문 드립니다

Sub loop1()
Dim i As Long
Dim iEnd As Long
Dim wk As Workbook
Dim sh As Worksheet
Dim wkT As Workbook
Dim shT As Worksheet
Dim r As Range
Dim rCopy As Range
Application.ScreenUpdating = False
Set wkT = ThisWorkbook
Set shT = wkT.Worksheets("Sheet1")
iEnd = shT.Range("A" & Rows.Count).End(xlUp).Row '' 630000 '''
For i = 1 To iEnd Step 4001
Set rCopy = shT.Range("A" & i).Resize(4001, 5) '''열(5)번호를 조정 하시면
Set wk = Workbooks.Add
Set sh = wk.Worksheets(1)
Set r = sh.Range("A1")
rCopy.Copy r
wk.SaveAs wkT.Path & "\" & i & ".csv"
wk.Close
Next i
End Sub

제가 참고한 매크로는 이거입니다

최종결과는 첫 행의 순번 삭제 / 첫 열의 연락처는 새 파일 생성될 때에도 계속 유지되어야 하는데

매크로에 내용 추가가 어려워서 문의드립니다ㅠㅠ

+

추가로 바탕화면의 지정된 폴더에 바로 저장할 수 있는 매크로가 있다면 같이 알려주시면 감사하겠습니다ㅠㅠ