エクセルのマクロについて質問です。

マクロのプログラムで、プログラムを動作させるシートを任意で選択するコマンドがわかりません。お力貸してください。

今、アクティブセルを含むそれより下のセルに、シートの名前が並べて書いてあります。例えば、A1がアクティブセルのとき、A1~A10まで(A11は空白セル(=終了条件))に、

Sheet2
Sheet3
  :
Sheet11

と書いてあります。

そして、あらかじめマクロに書いてあるプログラム
Sub Creat_Texts()
Sub_Rountine_1
Sub_Routine_2
End Sub

を、それぞれA1~A10で指定したシート上、つまりSheet2やSheet3で次々に実行していくようなマクロを作りたいです。

よろしくお願いします。

回答の条件
  • 1人2回まで
  • 登録:
  • 終了:2006/12/14 01:00:57
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:y3kz No.1

回答回数31ベストアンサー獲得回数9

ポイント40pt
Sheets("シート名").Activate

で"シート名"シートが選択されます。↓のようなコードでどうでしょうか。

Sub Creat_Texts()
    Dim myCell As Range
    
    Set myCell = ActiveCell
    
    Do While myCell.Value <> ""
        Sheets(myCell.Value).Activate
        
        Sub_Routine_1
        Sub_Routine_2
        
        Set myCell = myCell.Offset(0, 1)
    Loop
End Sub
id:ReoReo7

残念ながら、一つ目のシートで実行した時点でとまってしまいます。

2006/12/07 21:41:23

その他の回答2件)

id:y3kz No.1

回答回数31ベストアンサー獲得回数9ここでベストアンサー

ポイント40pt
Sheets("シート名").Activate

で"シート名"シートが選択されます。↓のようなコードでどうでしょうか。

Sub Creat_Texts()
    Dim myCell As Range
    
    Set myCell = ActiveCell
    
    Do While myCell.Value <> ""
        Sheets(myCell.Value).Activate
        
        Sub_Routine_1
        Sub_Routine_2
        
        Set myCell = myCell.Offset(0, 1)
    Loop
End Sub
id:ReoReo7

残念ながら、一つ目のシートで実行した時点でとまってしまいます。

2006/12/07 21:41:23
id:zuguimo No.2

回答回数19ベストアンサー獲得回数3

ポイント20pt

質問の理解を間違えていたらごめんなさい。

y3kzさんの回答で、元のシートに戻らないためエラーとなったと思います。

Set myCell = myCell.Offset(0, 1)

の前に最初のシートに戻る必要があると思います。

私は、for を使って作ってみましたので、記載しておきます。

シート名がA2からA10にあるのが前提です。

シート名が書かれた場所が、変わる場合別のプログラムが必要です。

Sub Creat_Texts()

'以下でシート選択

Dim アクティブシート, 選択シート As String

Dim I As Integer

アクティブシート = ActiveSheet.Name

For I = 2 To 3

選択シート = Range("A" & I).Value

Sheets(選択シート).Select

'既存のプログラム

Sub_Rountine_1

Sub_Routine_2

'次のシートへ]

Sheets(アクティブシート).Select

Next I

End Sub

以上です。4行目の

アクティブシート = ActiveSheet.Name

は、最初のアクティブシートが固定されていれば、そのシート名を使えば簡単です。

ちなみにSheets(1),Sheets(2),Sheets(3),Sheets(4),…

とすれば、左から何番目かのシートを選択出来るようです。

http://www.happy2-island.com/excelsmile/smile03/capter00100.shtm...

id:ReoReo7

ご丁寧にありがとうございます。

参考にさせて頂きます。

2006/12/14 00:58:20
id:ardarim No.3

回答回数897ベストアンサー獲得回数145

ポイント20pt

これでいけると思いますが、どうでしょう。

Sub test()

    Dim index As Worksheet
    Dim r As Long, c As Long
    
    Set index = ActiveSheet
    r = ActiveCell.Row
    c = ActiveCell.Column
    
    Do While index.Cells(r, c).Value <> ""
        Worksheets(index.Cells(r, c).Value).Select
        Call Creat_Texts
        r = r + 1
    Loop
    index.Select

End Sub
id:ReoReo7

ご丁寧にありがとうございます。

いつもいつもすばらしいプログラムですね。

2006/12/14 00:58:58

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません