Автоматическое скрытие стобцов

[staniiislav]

Здравствуйте.
Есть несколько файлов, все они собираются в один свод через "=". Есть две проблемы:

1) нужно сделать автоматическое скрытие столбцов в файле 1, если в 5-й строке 0 (меньше нуля) .
2) есть макрос сохранения отдельной книгой (в примере), доделать его, чтобы он сохранял форматы и значения. И как сделать (отдельный макрос), чтобы сохранял новым листом в книге?
Заранее спасибо!

[staniiislav]

первую проблему решил, вот таким кодом:

Private Sub Worksheet_Calculate()
Dim i As Long: Application.ScreenUpdating = False
For i = 4 To Cells(7, Columns.Count).End(xlToLeft).Column
If Cells(7, i) = 0 Then
Columns(i).Hidden = True
Else
Columns(i).Hidden = False: Columns(i).AutoFit
End If
Next
End Sub


Остается еще вторая проблема. Поможете?

[SAS888]

...доделать его, чтобы он сохранял форматы и значения

При копировании книги, копируется все: и форматы и значения. Я так понимаю, что Вам нужно исключить все формулы и ссылки, оставив только значения. Если так, то между строк Вашего кода

Set Wb = ActiveWorkbook

и

Wb.SaveAs FolderName & "\" & "свод" & " " & Date_name & ".xlsm"

вставьте код

Dim ws As Worksheet
For Each ws In Wb
    ws.UsedRange.Value = ws.UsedRange.Value
Next

Что касается Вашего желания

как сделать (отдельный макрос), чтобы сохранял новым листом в книге?

то здесь не понятно: если книга содержит несколько листов, то что значит "сохранить ее новым листом"?
А если лист всего один, то что Вам не дает сделать его копию и присвоить нужное имя? (как удалить все формулы и ссылки, мы уже проходили).

[staniiislav]

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

При копировании книги, копируется все: и форматы и значения. Я так понимаю, что Вам нужно исключить все формулы и ссылки, оставив только значения. Если так, то между строк Вашего кода

Set Wb = ActiveWorkbook

и

Wb.SaveAs FolderName & "\" & "свод" & " " & Date_name & ".xlsm"

вставьте код

Dim ws As Worksheet
For Each ws In Wb
    ws.UsedRange.Value = ws.UsedRange.Value
Next

Вы все правильно поняли, но не работает, формулы и ссылки остались, вот код:

Sub Save()
  Dim WbMain As Workbook
    Dim Wb As Workbook
    Dim FolderName As String
    Dim Date_name As String
    Application.EnableEvents = False
    Set WbMain = ActiveWorkbook
    FolderName = WbMain.Path & "\Архив"
    On Error Resume Next
    MkDir FolderName
    Date_name = CStr(InputBox("Введиту месяц и год (пример: Январь 2011) для текущего периода!", "Дата"))
If Date_name <> Empty Then
    If ActiveWorkbook.Visible = -1 Then
            ActiveWorkbook.Copy
            Set Wb = ActiveWorkbook
            Dim ws As Worksheet
                For Each ws In Wb
                    ws.UsedRange.Value = ws.UsedRange.Value
                Next
            Wb.SaveAs FolderName _
                      & "\" & "Сводная за " & " " & Date_name & ".xlsm"
            Wb.Close False
    End If
    MsgBox "Книга " & ActiveSheet.Name & " в виде одного файла сохранен в папку " & FolderName
End If
    Application.EnableEvents = True
End Sub

Что касается Вашего желания то здесь не понятно: если книга содержит несколько листов, то что значит "сохранить ее новым листом"?
А если лист всего один, то что Вам не дает сделать его копию и присвоить нужное имя? (как удалить все формулы и ссылки, мы уже проходили).

Сохранить рабочий лист "свод", в эту книгу но другим листом "свод январь 2011" например, и без ссылок и формул. ТОлько значения и форматы. Просто код сохранения листа в отдельную книгу у меня есть, а вот сделать копию листа только со значениями и форматами нет ((

[SAS888]

Я ж Вам ответил... Вот пример:

Sub Main()
    Sheets("свод").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = "свод январь 2011": .UsedRange.Value = .UsedRange.Value
    End With
End Sub

[staniiislav]

Спасибо вроде со всем разобрался. Появилась только одна маленькая проблема, которой раньше не было.
Создал фигуру, и к ней присвоил макрос сохранения, выдает прекращение работы экселя, но документ сохраняет. А если вставляю обычную кнопку ВБ тогда нормально все. Все может быть проблема?

[staniiislav]

Огромное спасибо за помощь! почти нашел решение!
Тему можно закрывать.