かめのあゆみ

日常やニュースとか思ってること等々きままに書くので御意見がある方等がありましたらコメントを残していただけると嬉しいです

コピー&sheet名変更マクロ

簡単ですけど・・

コピーしてコピーしたsheetの名前を変更するマクロ
全てがオリジナルじゃなくってよそからマクロコピって組み合わせたやつです
起動確認はしてるんだけど2010までは動いてたので大丈夫だと思いますpq
もし使われるのであれば自己責任でしてください

 マクロの説明
・指定したシート名を変更マクロです
表をコピーしてコピーした表のシート名を変更します
変更したシートは一番右側に移動するように組んでいます

sheetコピー⇒sheet(2)を一番右側に移動⇒sheet名変更⇒変更完了メッセージが表示される

流れはこうなってます
sheet名をキャンセルや無記名でOKボタンやを押した場合もコピーしたsheetが削除されるようになってます

 赤文字はsheet名なので使う際には変更してください

Sub 雛形()
'
' 雛形 Macro
'

'
Sheets("雛形").Copy Before:=Sheets(2)
Sheets("雛形 (2)").Select
Sheets("雛形 (2)").Move After:=Sheets(Sheets.Count)
On Error Resume Next
Dim wk
wk = Application.InputBox("新しいシート名を入力してください", Type:=2)
If wk <> False Then
ActiveSheet.Name = wk
End If
SheetDel ("雛形 (2)")
End Sub
Sub SheetDel(shname As String)
'ActiveなWorkbookに
'shnameで指定した名前のSheetが存在するか確認してから
'そのsheetを削除する
'なければそのようにメッセージする

Dim sh As Worksheet

For Each sh In Worksheets
If sh.Name = shname Then
'Sheetが存在する場合
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
Exit Sub
End If
Next sh

'Sheetがなかった場合
MsgBox "シート" & Chr(34) & shname & _
Chr(34) & "のコピーです。"

End Sub

 

こんなもんかな7種類のマクロが入ってますw