Sub записьлиставтекстфайл2()

Dim s As String
book = "предл просн.xls"
Workbooks(book).Activate
sheet = Application.ActiveSheet.Name

Open "C:\Users\Admin\Desktop\mitino\exp\almos2.csv" For Output As #1 'replace to your path
Open "C:\Users\Admin\Desktop\mitino\exp\price.csv" For Output As #2 'replace to your path

startBookIndex = Workbooks(book).Sheets("ALMOS2").Index
endBookIndex = Workbooks(book).Sheets("ALMOS4").Index
RowIndex = 1
i = 1

While startBookIndex <= endBookIndex
rowsCount = Workbooks(book).Worksheets(startBookIndex).UsedRange.Rows.count + 1
    While i < rowsCount
        s = Workbooks(book).Worksheets(startBookIndex).Cells(i, 1).Value & ";" _
        & Workbooks(book).Worksheets(startBookIndex).Cells(i, 2).Value & ";" _
        & Workbooks(book).Worksheets(startBookIndex).Cells(i, 3).Value & ";" _
        & Workbooks(book).Worksheets(startBookIndex).Cells(i, 4).Value & ";"
        Print #1, s
            Print #2, s
             If RowIndex > 99849 Then
                Close #2
                outputFileIndex = outputFileIndex + 1
                Open "C:\Users\Admin\Desktop\mitino\exp\sklad" & outputFileIndex & ".csv" For Output As #2 'replace to your path
                RowIndex = 0
            End If
            i = i + 1
            RowIndex = RowIndex + 1
    Wend
    i = 1
    startBookIndex = startBookIndex + 1
Wend
Close #2
Close #1
End Sub