Разделить файл на несколько частей

[makc9I]

Казанский, простите, действительно не заметил. Буду пробовать.

[makc9I]

небольшая проблемка, перед каждым сохранением спрашивает : сохранить файл? Как это автоматизировать?

[R Dmitry]

Сообщение от makc9I

R Dmitry, он весит 300 метров и содержит неразглашаемые данные, так что нельзя ( Могу скинуть dbf с такой же структурой, но без данных или сам впишу пару тройку рендомных данных

сбрасывайте десяток строк и файл с идентичной структурой.

[makc9I]

R Dmitry, да вроде все уже получилось. Итоговый скрипт выглядит так:

Sub split()
    Dim i As Long, s As String, ws As Worksheet
    Application.ScreenUpdating = False: Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 1000
        Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 999).Copy [A1]
        s = Replace(ThisWorkbook.FullName, ".dbf", "-" & (Fix(i / 1000) + 1) & ".dbf")
        ActiveWorkbook.SaveAs s, xlDBF3
        ActiveWorkbook.Close
    Next
End Sub

Осталось только отключить Alert'ы и все.

[GMV20061]

Сообщение от SAS888

Не зависимо от количества строк, можно так:

Sub DivFile()
    Dim i As Long, s As String, ws As Worksheet
    Application.ScreenUpdating = False: Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 500
        Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 499).Copy [A1]
        s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 500) + 1) & ".xls")
        ActiveWorkbook.SaveAs s: ActiveWorkbook.Close
    Next
End Sub

Искал решение для своей проблемки. Нашел у Вас. Большое спасибо.
Подскажите пож как изменить строку
s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 500) + 1) & ".xls")
чтобы имя каждого созданного файла соответствовало определенной ячейке в исходном файле (указаны уникальные значения). Например С9; С35; С61 и т.д., т.е в одном столбце через равное количество строк. Спасибо.

[Aleksandr H.]

s = Replace(ThisWorkbook.FullName, ".xls", "-C" & i & ".xls")

Так не будет?

[GMV20061]

Спасибо! Буду пробовать!

[GMV20061]

Сообщение от Aleksandr H.

s = Replace(ThisWorkbook.FullName, ".xls", "-C" & i & ".xls")

Так не будет?

Что-то не хочет. Выдает ошибку по строке
Sub DivFile()
Dim i As Long, s As String, ws As Worksheet
Application.ScreenUpdating = False: Set ws = ActiveSheet
For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 26
Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 25).Copy [A1]
s = Replace(ThisWorkbook.FullName, ".xls", "-C" & i & ".xls")
ActiveWorkbook.SaveAs s: ActiveWorkbook.Close Next
End Sub

[Aleksandr H.]

Какую?

[GMV20061]

При запуске макроса ничего не происходит.
При входе в макрос желтым выделяет строку
ActiveWorkbook.SaveAs s: ActiveWorkbook.Close