|
今ごろですが、サンプル。
作成したブックのシート枚数などが合わない等、エラー処理は入れてません。
PasteSpecial止めて調整。4/4(見ないだろうけど)
Sub Macro1()
Dim NEWWB As Workbook
Application.ScreenUpdating = False
Set NEWWB = Workbooks.Add
With ThisWorkbook
For i = 1 To 3
.Sheets(i).Cells.Copy NEWWB.Sheets(i).Range("A1")
NEWWB.Sheets(i).Name = .Sheets(i).Name
DoEvents
Next
End With
For i = 1 To 3
NEWWB.Sheets(i).Protect UserInterfaceOnly:=True, Contents:=True, Scenarios:=True
Next
NEWWB.SaveAs FileName:="保存フォルダ名\qqqqqqq.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.ScreenUpdating = True
NEWWB.Close
Set NEWWB = Nothing
MsgBox "終了"
End Sub
|
|