VBAの勤務割表の式を短く

　月間の勤務割表を作成しています。
1列3行を一枡として一人・一日の枡とし、勤務の割り振り状態を表示するものです。
列に日付、行を個人名（max16名）とし1列3行を名前の定義で13種類作成してあります。
別シートの各セルの入力番号に応じて13種類を貼り付けていますが、式を簡単にできませんでしようか？
　お教えくださいませんでしょうか？勉強不足は否めませんが。

尚名前の定義は、1行3列に1－－で勤務1・""-""で日勤・""公休""で公等にしてあります。

OS Windows7 Office2010

Sub 図形の貼付け2()
If Worksheets("メイン").Range("J9").Value Then
Select Case Worksheets("メイン").Range("J9").Value 1人－1日
Case 1:
ActiveSheet.Range("勤務１").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 2:
ActiveSheet.Range("勤務2").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 3:
ActiveSheet.Range("勤務3").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 4:
ActiveSheet.Range("日勤1").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 5:
ActiveSheet.Range("日勤2").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 6:
ActiveSheet.Range("日勤3").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Select
Else
Select Case Worksheets("メイン").Range("I9").Value
Case 2:
ActiveSheet.Range("明け").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 4:
ActiveSheet.Range("夜勤").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 5:
ActiveSheet.Range("公").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 6:
ActiveSheet.Range("有").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 7:
ActiveSheet.Range("特").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 8:
ActiveSheet.Range("振").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Case 9:
ActiveSheet.Range("欠").Select
Selection.Copy
Range("D10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Select
End If
End Sub

No.1 ベストアンサー 回答者： osamuy 回答日時： 2012/10/08 17:24

貼り付け処理を一元化するとか。

この回答へのお礼

　早速のご回答ありがとうございます。やはり勉強不足は否めません。確かに貼付けの一元化という方法もあるのですね。
参考書やネット検索等でこれからも勉強していきます。本当にありがとうございます。

お礼日時：2012/10/08 19:24