Мне нужно конвертировать все листы в файле 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