Конвертировать все таблицы Excel (с формулами) в CSV с удалением 2 верхних строк - PullRequest
0 голосов
/ 24 мая 2019

Мне нужно конвертировать все листы в файле Excel в CSV.Мне также нужно удалить две верхние строки.Выходной файл должен быть сохранен в папке (ProductSheets), которая будет создана в существующей исходной папке.

Я попробовал приведенный ниже код, но при запуске кода все листы открываются по отдельности, и мне приходится вручную его закрывать.

Sub ExportSheetsToCSV()
Application.DisplayAlerts = False
Dim newWs As Worksheet
Dim CurrentWB As Workbook, TempWB As Workbook
Dim filepath As String
    For Each newWs In Application.ActiveWorkbook.Worksheets
    newWs.Copy

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    End With

    Range("1:2").Delete

    If Len(Dir(ThisWorkbook.Path & "\ProductSheets", vbDirectory)) = 0 Then
    filepath = ThisWorkbook.Path
    MkDir (filepath & "\ProductSheets")
    End If

    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProductSheets\" & newWs.Name & ".csv", _
    FileFormat:=xlCSV, CreateBackup:=False
    Application.ActiveWorkbook.Saved = True
    Application.ActiveWorkbook.Close
Next
End Sub

Приведенный выше код оставляет все листы открытыми по отдельности.

Приведенный ниже код добавлен для сохранения всех ячеек с формулой, которые в противном случае были бы выведены как ref ref

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy

Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

1 Ответ

0 голосов
/ 24 мая 2019

Строка newWs.Copy создает копию существующего листа в качестве новой рабочей книги.Таким образом, вам не нужно немного остальной части вашего кода.Я бы сделал это как

Sub ExportAsCSVs()
Dim ws as worksheet
dim wb as workbook
for each ws in worksheets
   ws.copy  'creates new workbook with one sheet
   set wb = activeworkbook 'this is the workbook created above
   wb.sheets(1).rows("1:2").delete
   wb.saveas Filename:=ThisWorkbook.Path & "\ProductSheets\" & Ws.Name & ".csv", _
      FileFormat:=xlCSV, CreateBackup:=False
   wb.close false
next ws
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...