Добрый день, уважаемые обитатели:)
Есть такая проблемка, имеется макрос который из модели (отчёт в excel) выбирает выбранный лист и сохраняет его отдельно в новый книге, но при этом теряется формат ячеек (меняется заливка столбцов, строк - на неприемлимые цвета). Может кто сталкивался с такой проблемой и подскажет как мне выйти из данной ситуации.
Макрос:
Sub SAve_()
Application.DisplayAlerts = False
Dim nam As String
Dim date_ As Date
If Weekday(Date, 2) = 1 Then
date_ = Date - 3
Else:
date_ = Date - 1
End If
'On Error GoTo err
Sheets(Array("rBriefing_RB_FORMULAS")).Select
Sheets("rBriefing_RB_FORMULAS").Activate
Sheets(Array("rBriefing_RB_FORMULAS")).Copy
Sheets(Array("rBriefing_RB_FORMULAS")).Select
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
nam = Application.GetSaveAsFilename("rBriefing_RB_" & date_ & ".xls")
If nam = "False" Then
ActiveWorkbook.Close savechanges:=False
MsgBox ("Отчет не сохранен!")
Exit Sub
Else
ActiveWorkbook.SaveAs Filename:=nam, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.Dialogs(xlDialogSendMail).Show
ActiveWindow.Close
Sheets("title").Select
Range("F33").Select
End If
MsgBox ("Отчет успешно сохранен!") & nam
Exit Sub
err: MsgBox ("Отчет не сохранен!")
Application.DisplayAlerts = True
End Sub
Есть такая проблемка, имеется макрос который из модели (отчёт в excel) выбирает выбранный лист и сохраняет его отдельно в новый книге, но при этом теряется формат ячеек (меняется заливка столбцов, строк - на неприемлимые цвета). Может кто сталкивался с такой проблемой и подскажет как мне выйти из данной ситуации.
Макрос:
Sub SAve_()
Application.DisplayAlerts = False
Dim nam As String
Dim date_ As Date
If Weekday(Date, 2) = 1 Then
date_ = Date - 3
Else:
date_ = Date - 1
End If
'On Error GoTo err
Sheets(Array("rBriefing_RB_FORMULAS")).Select
Sheets("rBriefing_RB_FORMULAS").Activate
Sheets(Array("rBriefing_RB_FORMULAS")).Copy
Sheets(Array("rBriefing_RB_FORMULAS")).Select
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
nam = Application.GetSaveAsFilename("rBriefing_RB_" & date_ & ".xls")
If nam = "False" Then
ActiveWorkbook.Close savechanges:=False
MsgBox ("Отчет не сохранен!")
Exit Sub
Else
ActiveWorkbook.SaveAs Filename:=nam, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.Dialogs(xlDialogSendMail).Show
ActiveWindow.Close
Sheets("title").Select
Range("F33").Select
End If
MsgBox ("Отчет успешно сохранен!") & nam
Exit Sub
err: MsgBox ("Отчет не сохранен!")
Application.DisplayAlerts = True
End Sub