EXCEL VBAコミュの最終行への貼り付け

各シートのマクロのボタンに下記のマクロを作りました
Sub test()
Dim MyRow As Long
Dim Rng As Range
'A列の最終行の取得
MyRow = Range("A" & Rows.Count).End(xlUp).Row
'A列の最終行までのループ
For Each Rng In Range("A7:A" & MyRow)
'もし、B1の日付と同じなら次の処理へ
If Rng = Range("B1") Then
'範囲、C2:DV2をコピー
Rng.Offset(0, 2).Resize(, 144).Value = Range("C2:EP2").Value

'違ったら次へ
End If
'範囲内であれば続けて処理
Next Rng
End Sub

これをある一か所のボタンですべてのシートに適用するにはどうすればよろしいでしょうか？

シート名は　1月限　3月限　5月限　7月限　9月限　11月限　そしてこれらのシート名に（2）がついた1月限（2）という感じでシートがあります

コメント(29)

最初
全て
最新の40件

[1] mixiユーザー 07月08日 17:28

Worksheets.Select
ではいけませんか？

[2] mixiユーザー 07月08日 21:33

どのシートでも同じマクロを使いたいという意味なら、
そのマクロを標準モジュールに書いておいて、
｢フォーム｣ツールバーのボタンでそのマクロを割り当てます。
あとは、そのボタンを右クリックして、他のシートに貼りまくればＯＫです。

[3] mixiユーザー 07月08日 23:17

単純にすべてのシートに対応するなら、全部のシートに対して処理を行えばいい。
北国さんのソースを基本とするならこんな感じにするかな。

*-----------------------------------------------------------------*

Dim shtWk as Worksheet
Dim MyRow As Long
Dim Rng As Range

For each shtWk in worksheets

　with shtWk
'============================== ↓元のソースを流用

　　'A列の最終行の取得
　　MyRow = .Range("A" & Rows.Count).End(xlUp).Row
　　
　　'A列の最終行までのループ
　　For Each Rng In .Range("A7:A" & MyRow)
　　　'もし、B1の日付と同じなら次の処理へ
　　　If Rng = .Range("B1") Then
　　　　'範囲、C2:DV2をコピー
　　　　Rng.Offset(0, 2).Resize(, 144).Value = .Range("C2:EP2").Value

　　　'違ったら次へ
　　　End If
　　'範囲内であれば続けて処理
　　Next Rng

End With

next shtWk

*-----------------------------------------------------------------*

スペルミスがあったらすみません。。

[4] mixiユーザー 07月09日 09:36

皆さんありがとうございます

まだまだVBAは初心者なので、勉強が足りないことを痛感します

Worksheets.Select を使えば、一つのシートにボタンを設置し
そのボタンを操作することにより、他のシートにこちらの要求した
動作をさせることができるのでしょうか？

こちらの要求の動作は上記の動作です。
いままでシートごとにボタンを設置していたのですが
一回の動作ですべてを終わらせたくて考えてました

[7] mixiユーザー 07月10日 00:40

>北国さん

これは余談的なアドバイスですが、
VBAは”オブジェクト”をよく知らずに書くと、
かなり重い処理ができあがってしまいます。

また”オブジェクト”を知らないと自分のやりたいことの調査が大変です。

よってこの機にオブジェクトについて勉強することをオススメします。

えまえママさんのかかれてるこの文が
For each shtWk in worksheets
どういう意味だろう？とか。

ご自分で書いてるソース中の
Range("A" & Rows.Count).End(xlUp).Row
なにげなく使ってますが、
なんでシート名を明示的に指定しなくても良いんだろう？
とか。

ちゃんと勉強するとなると時間はかかると思いますが、
その分効率よくソースがかけるようになりますよ。

[8] mixiユーザー 07月10日 00:57

For each shtWk in worksheets ←これの意味がわからなかったら、

適当にExcelファイルを作成して、シートが複数枚ある状態で
====================================================
Sub hoge

Dim shtWk as Worksheets

For Each shtWk in Worksheets
　　'すべてのシートの.Range("A1")に"ほげ"を記入
shtwk.Range("A1").value = "ほげ"
Next shtWk

End Sub
====================================================

を、F8キー(･･･だっけ? .Netと混乱中)を押して一行ずつ動かしながら
どういう処理をしているかを見れば、だいたいの意味はなんとなく理解
できると思います。

何事も勉強が大事です。頑張ってください

[9] mixiユーザー 07月10日 15:52

返事が遅れてすいません

なかなか業務が忙しくまだ取り掛かることができないのですが

みなさん、詳しく、アドバイスなどありがとうございます

[10] mixiユーザー 07月11日 13:19

取り組んでみました

ところがシート名は　1月限　3月限　5月限　7月限　9月限　11月限　そしてこれらのシート名に（2）がついた1月限（2）という感じのものと

中にの表示が全く違うシートが他にも複数あり
えまえママさんのマクロを使ってみると表が違うシートが入っているため
エラーになってしましました

こちら側でシートを複数してして実行させることはできるでしょうか？

[11] mixiユーザー 07月11日 13:28

私の書いたコードは、問答無用ですべてのシートに反映させるものですからね。

シートを限定したい場合はシート（の名前）を指定して、実行すればいいと思います。

If shtwk.name = "1月限" then
..処理
End if

とか。
Select文を使用したり、中の処理を外だしにすると、もっとスッキリしたコードになると思います。

携帯からなので、ヒントのみで勘弁です～。

[12] mixiユーザー 07月11日 13:31

えまえママさん

ありがとうございます

返答の早さに感動を覚えました

奥が深いですね。エクセルって

[14] mixiユーザー 07月17日 14:01

Sub 限月シート更新処理()
Dim i As Integer, na As String
For i = 1 To 6 '6シート分行う
na = 2 * i & "月限"
Sheets(na).Select '月限シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行
Next '次のシートへ

For i = 1 To 6 '6シート分行う
na = 2 * i & "月限 (2)"
Sheets(na).Select '月限 (2)シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行
Next '次のシートへ

Sheets("取組計").Select '取組計シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行

Sheets("取高計 (2)").Select '取組計(2)シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行
End Sub

というマクロでシート名が2月限　4月限・・・12月限と指定できました

これを今度は1月限　3月限・・・11月限と奇数を選択したいのですが

どうすればよろしいでしょうか？

na = 2 * i－1 & "月限"
Sheets(na).Select '月限シート指定
としたらエラーになってしまいました

[15] mixiユーザー 07月17日 14:11

携帯からの横レスになりますが、関数の最初辺りで決められた（処理させたい）シート名形式でなければexitするコードを入れてみるとかはどうですかね？

例えば、月限と（2）付きが処理対象ならRightでシート名を切って分岐処理させるとかかな。

昔やった時には結構、ごり押し感が（笑）

[16] mixiユーザー 07月17日 15:12

携帯からなので…

For i = 1 to 11 Step 2

na = i & "ほにゃらら"

Next i

無理して計算とかしなくてもこれで行けるんじゃないかと思います。

あとは、ステップで実行してみて、変数に自分が思い描いている数値が入っているか、デバッグしながらやるのが一番だと思います。

[17] mixiユーザー 07月17日 15:33

＞土竜さん
ありがとうございます
分岐させる技を使うんですね

＞えまえママさん
前回からお世話になります
Sub 限月シート更新処理コーン()
Dim i As Integer, na As String
For i = 1 To 11 Step 2
na = i & "月限"
Sheets(na).Select '月限シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行
Next i '次のシートへ

For i = 1 To 11 Step 2
na = i & "月限 (2)"
Sheets(na).Select '月限 (2)シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行
Next i '次のシートへ

Sheets("取組計").Select '取組計シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行

Sheets("取高計 (2)").Select '取組計(2)シート指定
Application.Run "コーン手口b.xlsb!AT" '選択シートでマクロ実行
End Sub

としたのですがインデックスが有効でないとなってしまいます

いつもこのエラーに引っかかってしまいます

[19] mixiユーザー 07月18日 09:04

>Sedvicious さん
他のファイルのシートにある2月限　4月限・・・となっているものには

マクロが対応してくれるのですが

1月限　3月限・・・となっているファイルのシートには
na = 2 * i－1 & "月限"
Sheets(na).Select '月限シート指定
では、エラーが出てしまします

シート名も一緒で字体も同じなのですが行き詰ってしまいました。
他に問題があるとしたらどういったところでしょうか？

[20] mixiユーザー 07月18日 09:34

19　北国さん
エラーは何と出ているのですか？
ソレを書かなくちゃ、こっちは色々考えさせられちゃうよ。
　

[21] mixiユーザー 07月18日 09:36

Sedviciousさんの言う通り、ファイル名に問題があるんじゃないかな…
余計なスペースが含まれていたりとか、全角とか。

あとは、型が何か悪さしているとか。
na = cStr(2 * i - 1) & "月限"
とか…

携帯からやから、解答が試せないです

Variant型っていう、親切なんだか有難迷惑なんだわからん型のおかげで、型を意識しないで済むようになっていますが、cStrやらcIntやら…
その辺も意識して使うようにしたほうが後々楽になるかと思います。

[22] mixiユーザー 07月18日 09:55

失礼しました
実行エラー　９
インデックスが有効範囲にありませんとでます

えまえママさん
cStr(2 * i - 1)も同じエラーになってしまいました
型が悪さしているとはなんでしょうか？

[23] mixiユーザー 07月18日 10:27

やっぱ、シート名と取得したものが違うとしか…。

後は、実際シート名とか見てみないとわからないのですが、何分外にいるのでＰＣが手元に無いので…

力になれなくて申し訳無いです。

[24] mixiユーザー 07月18日 10:37

確認する意味で、naを何処かに出力して、シート名と比べてみて下さい。

[25] mixiユーザー 07月18日 11:15

携帯から何でヒントだけになりますが、横槍失礼します。

FOR EACH SH IN WORKSHEETS

SELECT CASE TRUE
CASE INSTR(1,SH.NAME,"月限")<>0
SELECT CASE TRUE
'ほにゃらら月限の場合
CASE RIGHT(TRIM(SH.NAME),2) = ﾞ月限ﾞ

処理A

'ほにゃらら月限（２）の場合
CASE STRCONV(RIGHT(TRIM(SH.NAME),3),VBNARROW) = ﾞ(2)ﾞ

処理B

END SELECT
CASE INSTR(1,SH.NAME,"取組計")<>0
'ほにゃらら取組計の場合
CASE RIGHT(TRIM(SH.NAME),3) = ﾞ取組計ﾞ

処理C

'ほにゃらら取組計（２）の場合
CASE STRCONV(RIGHT(TRIM(SH.NAME),3),VBNARROW) = ﾞ(2)ﾞ

処理D

END SELECT
END SELECT

NEXT SH

上記構文でどうでしょうか？
自分として気になる点がSelect文の中にさらにSelectが出来たかあやふやなんですよね～

スペルミスしてたらｻｰｾﾝ

[26] mixiユーザー 07月18日 12:09

すいません。
皆さんの言う通りシート名に空白が入っていました

大変失礼いたしました

Sub 限月シート更新処理()

Dim i As Integer, na As String
For i = 1 To 6 '6シート分行う
na = 2 * i - 1 & "月限"
Sheets(na).Select '月限シート指定
Application.Run "コーン手口b.xlsb!test" '選択シートでマクロ実行
Next '次のシートへ

For i = 1 To 6 '6シート分行う
na = 2 * i - 1 & "月限 (2)"
Sheets(na).Select '月限 (2)シート指定
Application.Run "コーン手口b.xlsb!test" '選択シートでマクロ実行
Next '次のシートへ

Sheets("取組計").Select '取組計シート指定
Application.Run "コーン手口b.xlsb!test" '選択シートでマクロ実行

Sheets("取高計 (2)").Select '取組計(2)シート指定
Application.Run "コーン手口b.xlsb!test" '選択シートでマクロ実行
End Sub

上記のマクロで起動させると

今度はModulel1　で今まではうまく機能していたのに
型が一致しないとなりました

Sub test()
Dim MyRow As Long
Dim Rng As Range
'A列の最終行の取得
MyRow = Range("A" & Rows.Count).End(xlUp).Row
'A列の最終行までのループ
For Each Rng In Range("A7:A" & MyRow)
'もし、B1の日付と同じなら次の処理へ
If Rng = Range("B1") Then
'範囲、C2:ED2をコピー
Rng.Offset(0, 2).Resize(, 134).Value = Range("C2:ED2").Value

'違ったら次へ
End If
'範囲内であれば続けて処理
Next Rng
End Sub

いったい何が悪いのでしょうか？

せっかく成功したのに、うまくいっているマクロなのに

エラーが出てきます

[27] mixiユーザー 07月18日 12:18

以前上手くいっていた時から何処をいじったのか？
そこを戻したらどうなるか？　調べてみましたか？
何処で何のエラーが起きたのか？は明確にして聞くべきだと思うよ。

チョットエラーが起きたからって聞くのが早すぎませんか？
確認事項をもう少しやってみませんか？
　

[28] mixiユーザー 07月18日 12:36

やっぱり、ステップ実行でポチポチやってみてどのラインによるエラーかを把握したほうがよさ気ね。

型が合わないってエラーは初歩でもあり、誰もが躓いたエラーだと思う。
これは自力で乗り越えることをオススメします。

[29] mixiユーザー 07月18日 12:56

>fenwickさん
>えまえママさん

ありがとうございます

なんとか自力でがんばってみました

結果をみると大したことなく
シートの中にエラー値があり、これを直したらなんなく起動しました

本当にありがとうございます

最初のほうは自力でなんとかできるのですが

応用を重ねていくと、行き詰って半べそになり

全べそになります。

非常に助かりました。これにより業務の効率があがるので大助かりです

ログインすると、残り4件のコメントが見れるよ