| 
    
     |  | ▼シスアド さん: こんにちは。
 
 >目的としては、単独で動作させるのが目的ではないんですけど
 >最終的には、データがBK2だけではなく縦にBK3BK4・・・と複数入れて
 >BK2は、sheet3,BK3はsheet4・・・というふうに実行結果を出力させていく
 >その時のsheetはデータがある数だけ作られるというようにしたいのですが・・・
 >意味が伝わりましたかね?わからなければいってください。
 
 はっきりではありませんが、何となくならわかります・・・が、
 
 >>下記のように、セルBK2に0.1.2.3のいづれかが入力された場合Caseによって条件があ>>るマクロを作成しました。
 >>これを同じSheetのリストという名前のセルBK2ではなく、データという名前のSheetの>>セルO2に値が入力されており、それを使用し、リストという名前に出力したいのですが>>どうしたらよいでしょうか?
 
 最初の投稿の↑の仕様とは違いますね!!
 
 マクロ実行前のシート構成
 
 マクロを含むブックには、
 xxxxというシート名のシート
 yyyyというシート名のシート(複数あるならすべて記述)
 ・
 ・
 
 というようにこんなところから 正確に記述してください。
 
 特に今回は、シートを追加するのですよね?
 だったら、どこに追加するかも正確に記述してください。
 
 
 マクロの入力データに相当するデータの情報も正確に記述してください。
 (まあ、これは、ある程度は記述されていましたが・・・)
 
 
 このマクロの入力データに相当するデータは、
 シートxxxxというシート名のシートのセルBK2から決まった行数では
 ありませんが、入力されています。
 
 A   B ・・・・ BK
 1             作成位置指示
 2              1
 3              2
 4              0
 5              3
 6              1
 7              2
 
 一例ですが、上記のように入力されています。
 行数は、上記の例ではセルBK7までですが、一定ではありません。
 3行の場合もあれば、20行の場合もあります。
 
 シートxxxxのセルBK2以下のセルの値を基に
 オートシェープの円を作成します。
 
 
 作成するオートシェープの円の作成位置がセルの値によって違います。
 
 又、セルBK2の値で作成するオートシェープの円は、
 
 このシートxxxxに作成するのではなく、
 新たに作成するシート(マクロで作成する)に作成します。
 
 同様にBK3の値によって、作成するオートシェープの円も
 別に新規作成されたシート上に作成します。
 
 このようにシートxxxxのセルBK2以下にオートシェープの円の作成指示データが
 ある限り新規にシートを作成し、
 その作成されたシート上に作成指示データで示される位置に
 オートシェープの円を作成します。
 
 それぞれのシートに作成するオートシェープの円の作成位置は、
 
 作成指示データ   シートのLeft、シートのTop
 0        159.75    29.25
 1        249.75    157.25
 2        343.75    29.25
 3        432.75    29.25
 
 
 上記のようになっています。
 
 
 とこのような仕様でよいのですか?
 
 だとしたら、シスアド さんこの程度の仕様の提示はしなければなりません。
 
 
 このような仕様だとして・・・・。
 
 ・新規ブックにシートを1枚のみにしてください。
 (既定で、3枚作成されていても削除して1枚にしてください)
 
 ・この1枚シートのシート名はSheet1としてください。
 このシートのセルBK2以降に円の作成指示番号が入っているとします。
 
 標準モジュールに
 '===================================================================
 Sub sample()
 Dim ok As Boolean
 Dim o_left As Double
 Dim o_top As Double
 Dim crng As Range
 Dim c As Range
 With Worksheets("sheet1")
 For Each c In .Range("bk2", .Cells(.Rows.Count, "bk").End(xlUp))
 ok = True
 Select Case c.Value
 Case 0
 o_left = 159.75
 o_top = 29.25
 Case 1
 o_left = 249.75
 o_top = 157.25
 Case 2
 o_left = 343.75
 o_top = 29.25
 Case 3
 o_left = 432.75
 o_top = 29.25
 Case Else
 ok = False
 End Select
 If ok = True Then
 With Worksheets.Add(after:=Worksheets(Worksheets.Count))
 .Name = "sheet" & c.Row
 DoEvents
 With .Shapes.AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
 .Fill.Visible = msoFalse
 End With
 End With
 End If
 Next
 End With
 End Sub
 
 
 記述したようなシートの準備が出来たら、
 上記のSampleを実行してみてください。
 
 セルBk2から、BK7に上述のようなデータが入力されていた場合、
 
 Sheet2からSheet7というシートが追加作成され、それぞれのシートに
 指示データに対応した位置に円が作成されます。
 
 |  |