Страницы: 1
RSS
Автоматическое сохранение листов в книге
 
Здравствуйте, задача следующая - нужно организовать сохранение копии первого листа(ЗАКАЗ) в текущей книге, где наименование листа берется из ячейки D1, но при этом копия должна иметь только значения  - без формул.
...при выполнении команды СОХРАНИТЬ
Изменено: Alexey Martynets - 20.03.2018 10:32:48
 
У вас ячейка D1 пустая, как в этом случае лист должен называться?
"Все гениальное просто, а все простое гениально!!!"
 
...ой, прошу прощения, в данной копии она С2
 
Код
Sub test()
    Sheets(1).Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = Range("с2").Value
        .UsedRange.Value = .UsedRange.Value
    End With
End Sub
Изменено: Nordheim - 20.03.2018 09:44:19
"Все гениальное просто, а все простое гениально!!!"
 
Блин, а я прочитал сохранить в другой книге... Утро...
Но чтобы добру зря не пропадать:
Код
Sub SaveCopySheet()
Dim newWB As Workbook, SHname$, oldWB As Workbook, arr()
Set oldWB = ThisWorkbook
SHname = oldWB.Sheets(1).[C2].Value
arr = oldWB.Sheets(1).UsedRange.Value
Set newWB = Workbooks.Add
oldWB.Sheets(1).Cells.Copy newWB.Sheets(1).[A1]
newWB.Sheets(1).[A1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
newWB.Sheets(1).Name = SHname
SHname = Left(oldWB.FullName, Len(oldWB.FullName) - InStr(StrReverse(oldWB.FullName), "\") + 1) & SHname & ".xlsx"
newWB.SaveAs Filename:=SHname, FileFormat:=xlOpenXMLWorkbook
End Sub
Изменено: Anchoret - 20.03.2018 10:19:39
 
Ругается чего - то
Изменено: Alexey Martynets - 20.03.2018 10:16:14
 
Alexey Martynets, ага. Но ругается по делу. Изменил код выше.
Повторюсь идет сохранение содержимого листа с индексом 1 (первый ярлык листа слева) в новую книгу под именем взятом из С2. Путь, по которому сохраняет - путь/каталог в  котором сохранена книга из которой берутся данные.

Можно еще обработку ошибок повесить, вдруг кто-то два раза подряд клацнет на кнопке макроса.
Изменено: Anchoret - 20.03.2018 10:26:36
 
Спасибо, но все таки необходимо сделать сохранение именно в текущей книге, при выполнении команды СОХРАНИТЬ.    
 
Код
Sub test()
    Sheets(1).Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = Range("с2").Value
        .UsedRange.Value = .UsedRange.Value
    End With
End Sub

Nordheim, все работает - спасибо !
Страницы: 1
Наверх