| |
どのようにうまくいかないかの記載が漏れておりました、申し訳ありません。
以下のように記載し、コピーされた後名前をつけて保存されるのですが、シート２のコードは消えておらず残ったままになっています。
Sub Macroコピー()
Dim new_book As Workbook
Dim vbc As Object, zu As Object
Worksheets.Select
Worksheets.Copy
Set new_book = ActiveWorkbook
For Each vbc In new_book.VBProject.VBComponents
If vbc.Type = 100 And vbc.properties("name") = " シート２ " Then
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End If
Next
Application.ScreenUpdating = True
ActiveWorkbook.SaveAs Filename:= _
ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets(1).Range("G3") & "-" & ThisWorkbook.Worksheets(1).Range("J3") & _
ThisWorkbook.Worksheets(1).Range("Q3") & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="" _
, ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
