[[20190318201743]]　『同じブックの複数のシートに同じマクロを実行した』（ブルー）　ページの最後に飛ぶ

『同じブックの複数のシートに同じマクロを実行したい』（ブルー）

いつもお世話になっております
同じブックの複数のシートに同じマクロを実行したいのですがどう書いたらよろしいでしょうか

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

実行するマクロの内容にもよりますが
標準モジュールで
Sub 複数のシートで使うマクロ()
ここに処理
End Sub
というプロージャを作成しておき
複数のシートのボタンで
Call　複数のシートで使うマクロ()
という処理を書けばいいと思います。

もし1つの操作で複数のシートに適用するという意味なら
Sub 複数のシートで使うマクロ(Byval 対象のシート as Worksheet)
ここに処理
End Sub
という処理を用意し
Call 複数のシートで使うマクロ(対象のシート１)
Call 複数のシートで使うマクロ(対象のシート２)
という処理を書けばいいと思います。
（高橋） 2019/03/18(月) 20:33

 シートを指定しなければ、
どのシートにも適用されるでしょうけど、
危なかしいですよね(^^;;
（SoulMan） 2019/03/18(月) 20:48

＞同じマクロを実行したい

例えば、どんなマクロですか？
ブルーさんの質問の仕方は、いつもそうですが、
具体的にやりたいことがあるのですよね。

（マナ） 2019/03/18(月) 21:48

Option Explicit

Sub 登録馬処理1()

    Dim 出馬表テスト As Worksheet
    Dim 処理後出馬表 As Worksheet
    Dim 元データ As Range

    Set 処理後出馬表 = Worksheets("処理後１")
    Set 出馬表テスト = Worksheets("処理前１")
    Set 元データ = 出馬表テスト.UsedRange

    Dim 最終行 As Long
    Dim 開始行 As Long
    Dim r As Long
    Dim shp As Shape

    開始行 = 元データ(1, 1).Row
    最終行 = 元データ.Rows.Count + 開始行

    'レース名取得
    Dim レース名 As String
    For r = 開始行 To 最終行
            レース名 = 元データ(r, 2).Offset(2, 0)
            Exit For
        End If
    Next r
        '距離

    Dim 距離 As String
    For r = 開始行 To 最終行
        If 元データ(r, 2).Value <> "" Then
            距離 = 元データ(r, 3).Offset(4, -1)
            Exit For
        End If
    Next r

    '日付
    Dim 日付 As String
    For r = 開始行 To 最終行
        If 元データ(r, 2).Value <> "" Then
            日付 = 元データ(r, 3).Offset(0, -1)
            Exit For
        End If
    Next r

    '馬情報開始行取得
    Dim 馬情報行 As Long
    For r = 開始行 To 最終行
        If 元データ(r, 6) <> "" Then
            馬情報行 = r + 2
            Exit For
        End If
    Next r

    'レース内容取得と書き出し
    Dim 馬名, 性齢毛色, 斤量, 調教師, 父馬名, 母馬名
    Dim cnt As Long
    cnt = 1
    For r = 馬情報行 To 最終行
        If 元データ(r, 6) <> "" Then

            cnt = cnt + 1 'カウンタ

            'データ取得
            馬名 = 元データ(r, 1).Value
            性齢毛色 = 元データ(r, 2).Value
            斤量 = 元データ(r, 3).Value
            調教師 = 元データ(r, 4).Value
            父馬名 = 元データ(r, 5).Value
            母馬名 = 元データ(r, 6).Value
            '*******************************
            'この間はご自身で考えてコードを追加してください
            '*******************************

            'データ書き出し
            処理後出馬表.Cells(cnt, 1) = 馬名
            処理後出馬表.Cells(cnt, 2) = 性齢毛色
            処理後出馬表.Cells(cnt, 3) = 斤量
            処理後出馬表.Cells(cnt, 4) = 調教師
            処理後出馬表.Cells(cnt, 5) = 父馬名
            処理後出馬表.Cells(cnt, 6) = 母馬名
            処理後出馬表.Cells(cnt, 7) = レース名
            処理後出馬表.Cells(cnt, 8) = 距離
            処理後出馬表.Cells(cnt, 9) = 日付
            '元データシート削除
            '*******************************
            'マクロの記録で記録されたコードを追加
            '*******************************

        End If
    Next r
    For Each shp In ActiveSheet.Shapes
If shp.Name <> "スイッチ" Then shp.Delete
Next
         Cells.Select
    Selection.ClearContents
        Sheets("処理後１").Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("登録").Select
    Range("c2").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
    Sheets("処理前１").Select
End Sub
というのを今は処理前１という名前のシートでしか実行できないのを　処理前２とか複数のシートに対して実行できるように改良したいのです
わかりにくくすいませんがよろしくお願いします
（ブルー） 2019/03/18(月) 22:30

つまり、複数組のシートを同時に処理したいのではなく
任意の組み合わせで実行したいということでしょうか。

シート名に決め事はあるのでしょうか。
例えば、必ず、処理後、処理前と数字からなるシート名であるとか。

（マナ） 2019/03/18(月) 22:50

処理前と数字の組み合わせです
処理後についてはできれば１つのシートでしたいです
よろしくお願いします
（ブルー） 2019/03/18(月) 22:56

＞処理後についてはできれば１つのシートでしたいです

処理後は、いつも同じシートという意味ですか。
ならば、SoulManさんの回答にあるように、

 ＞Set 出馬表テスト = Worksheets("処理前１")
                        ↓
   Set 出馬表テスト = ActiveSheet

として、処理したいシートを選択してから
マクロを実行するとどうでしょうか。

ActiveSheetの名前を確認するコードを追加するとよいかもしれません。

（マナ） 2019/03/18(月) 23:03

ありがとうございます
ちなみに　これって一つの操作で全ての処理前＋数字のシートにたいして実行するとかできますか
（ブルー） 2019/03/18(月) 23:07

いつもパターンになってきたので、降ります。

（マナ） 2019/03/18(月) 23:12

調べて組み合わせたところ

    Option Explicit
    Sub F()

        Dim Ws As Worksheet
            Dim 出馬表テスト As Worksheet
        Dim 処理後出馬表 As Worksheet
        Dim 元データ As Range

        Set 処理後出馬表 = Worksheets("処理後１")
        Set 出馬表テスト = ActiveSheet
        Set 元データ = 出馬表テスト.UsedRange

        Dim 最終行 As Long
        Dim 開始行 As Long
        Dim r As Long
        Dim shp As Shape

            開始行 = 元データ(1, 1).Row
        最終行 = 元データ.Rows.Count + 開始行

    For Each Ws In Worksheets
            Ws.Activate
            If Ws.Name Like "*あ*" Then
        'レース名取得
        Dim レース名 As String
        For r = 開始行 To 最終行
            If 元データ(r, 2).Value <> "" Then
                レース名 = 元データ(r, 2).Offset(2, 0)
                Exit For
            End If
        Next r
            '距離

        Dim 距離 As String
        For r = 開始行 To 最終行
            If 元データ(r, 2).Value <> "" Then
                距離 = 元データ(r, 3).Offset(4, -1)
                Exit For
            End If
        Next r

        '日付
        Dim 日付 As String
        For r = 開始行 To 最終行
            If 元データ(r, 2).Value <> "" Then
                日付 = 元データ(r, 3).Offset(0, -1)
                Exit For
            End If
        Next r

        '馬情報開始行取得
        Dim 馬情報行 As Long
        For r = 開始行 To 最終行
            If 元データ(r, 6) <> "" Then
                馬情報行 = r + 2
                Exit For
            End If
        Next r

        'レース内容取得と書き出し
        Dim 馬名, 性齢毛色, 斤量, 調教師, 父馬名, 母馬名
        Dim cnt As Long
        cnt = 1
        For r = 馬情報行 To 最終行
            If 元データ(r, 6) <> "" Then

                cnt = cnt + 1 'カウンタ

                'データ取得
                馬名 = 元データ(r, 1).Value
                性齢毛色 = 元データ(r, 2).Value
                斤量 = 元データ(r, 3).Value
                調教師 = 元データ(r, 4).Value
                父馬名 = 元データ(r, 5).Value
                母馬名 = 元データ(r, 6).Value
                '*******************************
                'この間はご自身で考えてコードを追加してください
                '*******************************

                'データ書き出し
                処理後出馬表.Cells(cnt, 1) = 馬名
                処理後出馬表.Cells(cnt, 2) = 性齢毛色
                処理後出馬表.Cells(cnt, 3) = 斤量
                処理後出馬表.Cells(cnt, 4) = 調教師
                処理後出馬表.Cells(cnt, 5) = 父馬名
                処理後出馬表.Cells(cnt, 6) = 母馬名
                処理後出馬表.Cells(cnt, 7) = レース名
                処理後出馬表.Cells(cnt, 8) = 距離
                処理後出馬表.Cells(cnt, 9) = 日付
                '元データシート削除
                '*******************************
                'マクロの記録で記録されたコードを追加
                '*******************************

            End If
        Next r
        For Each shp In ActiveSheet.Shapes
    If shp.Name <> "スイッチ" Then shp.Delete
    Next
    ActiveSheet.Cells.Select
        Selection.ClearContents
            Sheets("処理後１").Select
        Selection.Cut
        Application.CutCopyMode = False
        Selection.Cut
        Sheets("登録").Select
        Range("c2").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
            End If
        Next Ws
    End Sub
を作ってみたのですが
登録というシートの内容が何故か消えてしまいます
消える部分以外は大丈夫なのですが・・・

（ブルー） 2019/03/19(火) 21:01

 多分..

     For Each Ws In Worksheets
            Ws.Activate

 の ws.Activateでシート名に関わりなくActiveにしている。

 ActiveSheet.Cells.Select
        Selection.ClearContents

 ここまで生きているので、登録シートの位置に依っては空白になるかも...
 Activeにする必要はあるとは思えませんが、

            If Ws.Name Like "*あ*" Then
                Ws.Activate

 に変更するとどうなるでしょう。

（seiya） 2019/03/19(火) 21:58

とりあえずいいみたいです
or Each Ws In Worksheets

        If Ws.Name Like "*あ*" Then
    Ws.Activate
 ですよね
（ブルー） 2019/03/19(火) 22:38

この件は解決しましたが
あ１のシートのデータは通常に動作されますが
あ２のシートのデータが登録というシートに反映されません　あ２のシートは消えています
（ブルー） 2019/03/19(火) 23:00

 >あ２のシートは消えています
 この意味が分かりません。

     ActiveSheet.Cells.Select
        Selection.ClearContents

 このActiveSheetはWs ですよね?
 Cells.ClearContentsしてしまって大丈夫ですか？

 *あ*のシート全てクリアしてしまっていませんか？

            Sheets("処理後１").Select
        Selection.Cut
 これも何をしているのか理解できません。
 予めSheets("処理後１")のある範囲をSeletしているということですか？
（seiya） 2019/03/19(火) 23:16

 それと
 1) Set 出馬表テスト = ActiveSheet
 出馬表テストは状況によって参照が変わるのですか？
 そうでなければ、普通このような書き方はしません。

 2)
        Dim レース名 As String
        For r = 開始行 To 最終行
            If 元データ(r, 2).Value <> "" Then
                レース名 = 元データ(r, 2).Offset(2, 0)
                Exit For
            End If
        Next r
            '距離
        Dim 距離 As String
        For r = 開始行 To 最終行
            If 元データ(r, 2).Value <> "" Then
                距離 = 元データ(r, 3).Offset(4, -1)
                Exit For
            End If
        Next r
        '日付
        Dim 日付 As String
        For r = 開始行 To 最終行
            If 元データ(r, 2).Value <> "" Then
                日付 = 元データ(r, 3).Offset(0, -1)
                Exit For
            End If
        Next r
        '馬情報開始行取得
        Dim 馬情報行 As Long
        For r = 開始行 To 最終行
            If 元データ(r, 6) <> "" Then
                馬情報行 = r + 2
                Exit For
            End If
        Next r
 この4つのループはWsが変わるたびに同じ動きをしていますので外へ出してしまった方がすっきりしませんか？

（seiya） 2019/03/19(火) 23:31

毎週更新されるのであのつく全てのシートのデータは消して構いません
流れとしては
あのつくシートにデータが有る
↓
処理後シートにデータを整理する
↓
登録というシートにデータを蓄積する
です
わかりにくくすいません
（ブルー） 2019/03/20(水) 16:53

コメント返信：

[ 一覧(最新更新順) ]

[[20190318201743]] 『同じブックの複数のシートに同じマクロを実行した』（ブルー） ページの最後に飛ぶ

[[20190318201743]]　『同じブックの複数のシートに同じマクロを実行した』（ブルー）　ページの最後に飛ぶ