2015-04-01 3 views
0

Я пытался использовать макрос, чтобы разделить мою таблицу на несколько новых файлов на каждые 5000 строк и сохранить заголовок. Я попробовал этот код, но получил сообщение об ошибке "enter image description hereСплит каждые 5000 строк с заголовком на несколько новых листов

Код:

Sub Macro1() 
Dim inputFile As String, inputWb As Workbook 
    Dim lastRow As Long, row As Long, n As Long 
    Dim newCSV As Workbook 

inputFile = GetOpenFilename 

Set inputWb = Workbooks.Open(inputFile) 

With inputWb.Worksheets(1) 
    lastRow = .Cells(Rows.Count, "A").End(xlUp).row 

    Set newCSV = Workbooks.Add 

    n = 0 
    For row = 2 To lastRow Step 5000 
     n = n + 1 
     .Rows(1).EntireRow.Copy newCSV.Worksheets(1).Range("A1") 
     .Rows(row & ":" & row + 5000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A2") 

     'Save in same folder as input workbook with .xlsx replaced by (n).csv 
     newCSV.SaveAs Filename:=Replace(inputWb.FullName, ".xlsx", "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False 
    Next 
End With 

newCSV.Close saveChanges:=False 
    inputWb.Close saveChanges:=False 

End Sub 

Ошибка выделена здесь в соответствии с "Debug":

Set inputWb = Workbooks.Open(inputFile) 
+0

Похоже, что проблема находится в 'GetOpenFilename'. Поместите 'Debug.Print inputFile' сразу после назначения (например,' inputFile = GetOpenFilename') и проверьте окно Immediate (Ctrl + G) после сбоя, чтобы увидеть, что сообщается. – Jeeped

+0

Вы пробовали 'inputFile = Application.GetOpenFilename'? – Jeeped

+0

Непосредственная окно не показывает ничего, когда я пытаюсь это «Sub macro1() Dim файл_ввода As String, inputWb Как Workbook Dim lastRow As Long, грести As Long, п As Long Dim newCSV Как Workbook файл_ввода = GetOpenFilename Debug.Print inputFile End Sub " –

ответ

0

Я предлагаю вам пропустить опцию GetOpenFileName и перейти для другого - быть конкретным в этом формате:

"C:\Path\To\ABCDE.xlsx" 

as de хвостом от John_w по MrExcel.com.

+0

Я не знаю, ошибается ли мой путь или что, «/Users/annll/Downloads/Workbook5.xlsx» не удалось найти. –

+0

Может помочь дисковод и обратная косая черта. – pnuts

+0

Хорошо, проблема с дорогой в порядке, но она просит меня открыть файл, но он уже открыт. Если я скажу «да», то он снова откроется, и мой макрос исчезнет, ​​если я скажу «нет», это все та же ошибка «Open object failed» –

0

просто измените его на ActiveWorkbook , если только вы не планируете его запускать для другой книги, а затем использовать ее.

Sub Macro1() 
Dim inputFile As String, inputWb As Workbook 
    Dim lastRow As Long, row As Long, n As Long 
    Dim newCSV As Workbook 

With ActiveWorkbook.Worksheets(1) 
    lastRow = .Cells(Rows.Count, "A").End(xlUp).row 

    Set newCSV = Workbooks.Add 

    n = 0 
    For row = 2 To lastRow Step 5000 
     n = n + 1 
     .Rows(1).EntireRow.Copy newCSV.Worksheets(1).Range("A1") 
     .Rows(row & ":" & row + 5000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A2") 

     'Save in same folder as input workbook with .xlsx replaced by (n).csv 
     newCSV.SaveAs Filename:=n & ".csv", FileFormat:=xlCSV, CreateBackup:=False 
    Next 
End With 

newCSV.Close saveChanges:=False 

End Sub 

ваша проблема в

файл_ввода = GetOpenFileName

Set inputWb = Workbooks.Open (файл_ввода)

ваш не говоря это то, что GetOpenFileName является

и там нет необходимости повторно открывать

использование ACtiveWorkbook

Смежные вопросы