Страницы: 1
RSS
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Всем доброго времени суток.
Нужен макрос, для сохранения последнего видимого листа в файл тип файла "CSV (разделители - запятые)".
Сохраняем в туже директорию с таким же именем как у исходного файла.
Как ни пробовал переделать шаблон ни чего путного не получается.
Изменено: Николай - 15.04.2019 18:47:23
 
Вроде работает  :)
Код
Sub CSV()
    
    Dim WS As Worksheet
    Dim LastWS As Long
    Dim Name As String

    Name = ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsm", ".csv")
    For Each WS In ThisWorkbook.Worksheets
        If WS.Visible = True Then LastWS = WS.Index
    Next
    
    ThisWorkbook.Worksheets(LastWS).Copy
    ActiveWorkbook.SaveAs (Name)
    
End Sub
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Вот именно что вроде... Нужно указать не только расширение, но и формат! Помогает рекордер.
 
Код
Sub CSV()
    
    Dim WS As Worksheet
    Dim LastWS As Long
    Dim Name As String

    Name = ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsm", ".csv")
    For Each WS In ThisWorkbook.Worksheets
        If WS.Visible = True Then LastWS = WS.Index
    Next
    
    ThisWorkbook.Worksheets(LastWS).Copy
    ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSVUTF8
    
End Sub
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Мой Эксель не знает что такое xlCSVUTF8...
У меня в 2010 работает так:
Код
ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSV
Изменено: Hugo - 15.04.2019 20:05:41
 
Не работает ни так
Код
ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSVUTF8

Ни так
Код
ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSV

В первом случае

Во втором
Изменено: Николай - 15.04.2019 21:53:49
 
Вот пример файла.
 
Попробуйте заменить это:
Код
Name = ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsm", ".csv")
На это:
Код
Name = ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsx", ".csv")


Формат использовать: xlCSV
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Все равно ошибка (как во втором случае)
 
Погодь. У меня макрос хранится в персональной книге макросов. И запускается из панели быстрого доступа.

Из файла работает нормально.
НО нужно чтобы запускался из книги макросов. Так как нужно будет обрабатывать присылаемые файлы.
Приношу извинения, что не указал данный нюанс.
 
Попробуйте так, должно сработать.
Код
Sub CSV()
     
    Dim WS As Worksheet
    Dim LastWS As Long
    Dim Name As String
    
    For Each WS In ActiveWorkbook.Worksheets
        If WS.Visible = True Then LastWS = WS.Index
    Next

    Name = ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv")
    
    ActiveWorkbook.Worksheets(LastWS).Copy
    ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSV
     
End Sub
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Цитата
Valo написал:
Попробуйте так, должно сработать.
Гениально. Все работает. Отлично. Благодарю от всей души.
 
Дописал после сохранения новой книги следующий код.
Код
ActiveWorkbook.Close False 'Закроет активную книгу без сохранения   

Никак не могу добавить к имени файла нужный текст.
Код
Name = ActiveWorkbook.Path & "\" & Replace(Otchet_ & ActiveWorkbook.Name, ".xlsx", ".csv")

Что не так?
 
Код
Name = ActiveWorkbook.Path & "\" & Otchet_ & Replace(ActiveWorkbook.Name, ".xlsx", ".csv")
 
Hugo, Не работает. То есть сохраняет НО только исходное имя.
 
Получилось?
Код
Sub CSV()
     
    Dim WS As Worksheet
    Dim LastWS As Long
    Dim Name As String
    
    For Each WS In ActiveWorkbook.Worksheets
        If WS.Visible = True Then LastWS = WS.Index
    Next

    Name = ActiveWorkbook.Path & "\" & "Otchet_" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv")
    
    ActiveWorkbook.Worksheets(LastWS).Copy
    ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSV
    ActiveWorkbook.Close False
     
End Sub
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Valo,
Цитата
Valo написал:
Получилось?
А то...
Благодарю.
Как это я на кавычки не обратил внимание, ведь когда пробовал, внутри скобок, то писал с кавычками...
 
Цитата
Николай написал:
Что не так?
- как оказалось всё... :(
Страницы: 1
Наверх