[[20171205115455]]　『マクロの複写について』（hiro）　ページの最後に飛ぶ

『マクロの複写について』（hiro）

ファイルが十数個有り、各々シートが1月から12月まであります。
各々のファイルの11月を一番左に移動し
新規シート作成しそこに縦横入れ替えて保存するマクロを作りました。
今後、他の月も10月でしたら10月だけ同じようにしたいのですが
マクロの事態の複写ってどうすればできるのでしょうか？
今はマクロ名は「Macro11」といのがあります
よろしくお願いします。

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

Sub Sample()

  Dim NMh

  NMh = Month(Now()) & "月"

  Sheets(NMh).Select

Call　Macro11

End Sub
（Q::） 2017/12/05(火) 13:39

BOTさん有難う御座います
今あるマクロ（PERSONAL.XLSB　　マクロ名　Macro11　　）
を名前を変えて（Macro10）とかで追加保存できないものでしょうか？
あるいはマクロ名　Macro11　　の中の記述で
Sub Macro11()　　以下コピーして
　　・
　　・
Sub Macro10()　　
　　・
　　・
Sub Macro09()
Sub Macro08()　　と下に追加保存していけばできるものでしょうか？

　　・
　　・
　　・
よろしくお願いします。

（hiro） 2017/12/05(火) 14:09

この様な事？？？

Sub Macro11()

  Dim NMh

  NMh = Month(Now()) & "月"

  Sheets(NMh).Select
    Worksheets(NMh).Move Before:=Worksheets(1)

End Sub

Sub Macro12()

  Dim NMh

  NMh = Month(Now()) & "月"

  Sheets(NMh).Select
    Worksheets(NMh).Move Before:=Worksheets(1)

End Sub

Sub Macro1()

  Dim NMh

  NMh = Month(Now()) & "月"

  Sheets(NMh).Select
    Worksheets(NMh).Move Before:=Worksheets(1)

End Sub

Sub Macro2()

  Dim NMh

  NMh = Month(Now()) & "月"

  Sheets(NMh).Select
    Worksheets(NMh).Move Before:=Worksheets(1)

End Sub
（Q::） 2017/12/05(火) 14:25

中身が同じなら
玄関が違うだけで
同じ動きになりますが
出来ない事はないです
（Q::） 2017/12/05(火) 14:26

なぜにbot？
笑い
（Q::） 2017/12/05(火) 14:31

あっそうです。ありがとう御座います
只、Macro11という名前があるので11月分だけはそれでできるのですが
Macro10とかMacro09とか無いので、どうやって作るのでしょうか？
マクロ作成で1月～12月まで作らないといけないものでしょうか？
説明不足でしたが、各月にそれぞれの月の処理しかしません。
一度に数か月分まとめてする事はありません。

別件ですが、ＢＯＴさんではなかったでしょうか？
『マクロの複写について』（hiro）　>>BOT
とあったものですから。

（hiro） 2017/12/05(火) 14:47

名前はいいとして

先ず　
1月　2月～12月のシートが有るのですよね
下記のマクロは　当月のマクロを選択して　当月シートを左に移動するマクロです

Sub Macro2()

  Dim NMh
  NMh = Month(Now()) & "月"
  Sheets(NMh).Select
 Worksheets(NMh).Move Before:=Worksheets(1)
End Sub

此処から下記マクロを挿入すればいいと思います
＞新規シート作成しそこに縦横入れ替えて保存するマクロを作りました
（Q::） 2017/12/05(火) 15:37

どうも有難うございます
素人考えですが、マクロ名がないと一月の限定処理ができない気がするのですが
それは大丈夫でしょうか？
遅れましたが下記マクロがあります。
Sub Macro11()
'
' Macro11 Macro
'

    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    Sheets("11月").Select
    Sheets("11月").Move Before:=Sheets(1)
    Sheets("11月").Select
    Sheets.Add
    Sheets("11月").Select
    Range("B5:AG22").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("A22").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("1:21").Select
    Range("A21").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWorkbook.Save
End Sub

よろしくお願い致します。

（hiro） 2017/12/05(火) 15:57

ちゃんと纏めてないけど

こんな感じ？　　これで動くと思うけど
ただ　自動記録に乗っけただけだから
かなり無駄が多いかな

Sub Macro11()
'
' Macro11 Macro
'

  Dim NMh
  NMh = Month(Now()) & "月"
  Sheets(NMh).Select
 Worksheets(NMh).Move Before:=Worksheets(1)
    Sheets.Add
Sheets(NMh).Range("B5:AG22").Copy

   Sheets("Sheet1").Range("A2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("A22").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("1:21").Select
    Range("A21").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWorkbook.Save
End Sub
（Q::） 2017/12/05(火) 16:11

今月は12月だから
これで　12月の処理をしてくれると思います
コピーで試してください
（Q::） 2017/12/05(火) 16:13

んー、横から失礼しますね。

余計な枝葉を切っていくと、こんな感じでしょうか？（コピー先は毎月ずらす、とかあります？）なお、コピー対象のシートをアクティブにしてからマクロを実行すれば良いので、1つのマクロだけで全月対応できますよ。

 Sub test()
    Dim wk1 As Worksheet
    Dim wk2 As Worksheet

    Set wk1 = ActiveSheet
    wk1.Move Before:=Sheets(1)

    Set wk2 = Sheets.Add
    wk1.Range("B5:AG22").Copy
    wk2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=True

    ActiveWorkbook.Save
    Application.CutCopyMode = False
 End Sub
（???） 2017/12/05(火) 16:25

???様

A22にも貼り付けてません？

＞Range("A22").Select
＞Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
＞False, Transpose:=True

 Rows("1:21").Selectして　　さくじょしてますよね
 Selection.Delete Shift:=xlUp

重複作業して
結果　A1に貼り付けた　って事なのか

笑い
（Q::） 2017/12/05(火) 16:45

???様
有難う御座います

ちゃんと読んでくださって

って書くの忘れてました
（Q::） 2017/12/05(火) 16:46

 Set wk1 = ActiveSheet

上記になってますので

当月をまず　アクティブしないと

うまく行かないかないので

ここだけは　注意ですかね

（Q::） 2017/12/05(火) 16:53

手操作したのを自動記録したのでしょうね。だから回転なしで1回貼って、回転させて更に貼って、後のを残して消してる。つまり、A1に回転して貼れば1回で済む、という訳です。後から考えれば無駄と判りますが、難しい命令が書かれていたので、消して良いのか判断できなかったものと思われます。

アクティブシートを対象とし、追加シート名がSheet1でなくとも良いようにしたので、使いやすくなったかと思いますよ。後は、1月は年変わりで違う処理がありそうですが、1月のマクロを貼ってくれていないので、書けませんでした。まぁ、If文でシート名を調べて、1月だったら何々、という処理を追加するだけですが。
（???） 2017/12/05(火) 17:18

皆様ありがとう御座います。
マクロが初めてなので壊したらどうしようとか思いつつ
上書きしてしまうと復元できないのですよね？
一つのファイルにシートが1月から12月まであり、
一月単位で、例えば今12月でしたら11月分のみ全ファイルを
一番左に新しいシートを作り（他ソフトが自動で一番左シートしか読まない為）
そこに縦横入れ替えて保存したい
（丹に貼り付けただけだと値が変わるので改めて値だけ複写、それを更にコピーして
縦横入れ替えて保存という処理をしています）

どうなるか試してみます。ありがとうございます。

（hiro） 2017/12/05(火) 17:26

バックアップはちゃんと取ってから
やりましょうね
取り返しがつかなくなりますから
（Q::） 2017/12/05(火) 17:27

マクロだけのバックアップしたい時、どこにあるのでしょうか？
今、どのエクセルシート開いてもマクロ名　Macro11　　が実効できるので
どこかに統一されてマクロ名　Macro11　　があると思うのですが
（一応、メモ帳にコピペしました。）

（hiro） 2017/12/05(火) 17:48

ブック自体を別名で保存すれば
同じ内容ブックが出来上がります

もし壊れたら
名前を元に戻せばいいとおもいます

データーも大切でしょうから
（Q::） 2017/12/05(火) 17:54

どうもありがとうございます。
ブックと言いますのはマクロの編集ボタン押した時のPERSONAL・XLSBファイルでしょうか？
ファイルタブ押しても、上書き保存か、あるいはエクスポートですが、Module1.bas　とか出てますが
これを変えて保存いいのでしょうか？

バックアップといいましても編集画面で中身を書き換えてますので、結局マクロ名は
「PERSONAL.XLSB!Macro11」一つしかありませんが・・・

（hiro） 2017/12/05(火) 18:14

ありがとうございます。

 Sub test()
    Dim wk1 As Worksheet
    Dim wk2 As Worksheet

    Set wk1 = ActiveSheet
    wk1.Move Before:=Sheets(1)

    Set wk2 = Sheets.Add
    wk1.Range("B5:AG22").Copy
    wk2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=True

    ActiveWorkbook.Save
    Application.CutCopyMode = False
 End Sub

こちらは値が変わってしまってダメでした。

Sub Macro11()

 ' 
 ' Macro11 Macro 
 '

  Dim NMh
  NMh = Month(Now()) & "月"
  Sheets(NMh).Select
 Worksheets(NMh).Move Before:=Worksheets(1)
    Sheets.Add
Sheets(NMh).Range("B5:AG22").Copy

   Sheets("Sheet1").Range("A2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("A22").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("1:21").Select
    Range("A21").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWorkbook.Save
End Sub

こちらは値はちゃんと取れましたが現在の月が強制されてしまい
希望のシート月が選べませんでした。

試行錯誤してみます。

（hiro） 2017/12/05(火) 18:19

私の頭では直ぐにできないので
今あるマクロ（PERSONAL.XLSB　　マクロ名　Macro11　　）を
１２行（各々の月用）コピペできないでしょうか？
中の数字を11から10とかに編集するだけなので、私の頭でも直ぐにできます。
よろしくお願いします。

（hiro） 2017/12/05(火) 18:26

又、木曜日に訪問します
有難うございました
（hiro） 2017/12/05(火) 20:56

余談ですが、
＞『マクロの複写について』（hiro）　>>BOT
＞とあったものですから。
これはたぶん、Bottom (line) Of Thread とかなんとかの略ではないですか。
それをクリックすると、このスレッドの最後に飛べます。

（γ） 2017/12/05(火) 22:06

単にBOTtomの略かな。
（γ） 2017/12/05(火) 22:27

???さんの作ったのを解説します

Sub test()　　　　　　　　　　　’マクロ名　test

    Dim wk1 As Worksheet　　　　　’　宣言　wk1　wk2はワークシートです　　
    Dim wk2 As Worksheet
    Set wk1 = ActiveSheet　　　　　'wk1に現在選択しているシートをあてがいます
    wk1.Move Before:=Sheets(1)　　'wk1　（現在選択しているシート）を左移動　
    Set wk2 = Sheets.Add　　　　　　'新しいシート作ってwk2とします
    wk1.Range("B5:AG22").Copy　　　'wk1（現在選択しているシート）のB5からAG22までコピーします
    wk2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=True　　　　　'wk2（新しいシート)に立横変えて貼り付
    ActiveWorkbook.Save　　　　　　　　　　　　　　　　　'ファイルを上書き
    Application.CutCopyMode = False　　　　　　　　　　　'コピーモードを中止
 End Sub
＞こちらは値が変わってしまってダメでした。
処理したい月のシートを選択してないからと思います

正直私の書いたのは
前回も説明してますが当月処理前提です
それが　下記の命令です

  NMh = Month(Now()) & "月"
  Sheets(NMh).Select
 Worksheets(NMh).Move Before:=Worksheets(1)

（Q::） 2017/12/06(水) 10:08

下記の様に12個作ったほうがいいかな？？？？

Sub Macro1()

    Sheets("1月").Move Before:=Sheets(1)
    Sheets("1月").Range("B5:AG22").Copy
 　　Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      Application.CutCopyMode = False
     ActiveWorkbook.Save
End Sub

Sub Macro2()

    Sheets("2月").Move Before:=Sheets(1)
    Sheets("2月").Range("B5:AG22").Copy
 　　Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      Application.CutCopyMode = False
     ActiveWorkbook.Save
End Sub
Sub Macro3()

    Sheets("3月").Move Before:=Sheets(1)
    Sheets("3月").Range("B5:AG22").Copy
 　　Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      Application.CutCopyMode = False
     ActiveWorkbook.Save
End Sub

Sub Macro7()

    Sheets("7月").Move Before:=Sheets(1)
    Sheets("7月").Range("B5:AG22").Copy
 　　Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      Application.CutCopyMode = False
     ActiveWorkbook.Save
End Sub
Sub Macro8()

    Sheets("8月").Move Before:=Sheets(1)
    Sheets("8月").Range("B5:AG22").Copy
 　　Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      Application.CutCopyMode = False
     ActiveWorkbook.Save
End Sub

Sub Macro11()

    Sheets("11月").Move Before:=Sheets(1)
    Sheets("11月").Range("B5:AG22").Copy
 　　Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      Application.CutCopyMode = False
     ActiveWorkbook.Save
End Sub

Sub Macro12()

    Sheets("12月").Move Before:=Sheets(1)
    Sheets("12月").Range("B5:AG22").Copy
 　　Sheets.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
      Application.CutCopyMode = False
     ActiveWorkbook.Save
End Sub
（Q::） 2017/12/06(水) 10:23

私のコードで値が変わるというのは、対象月のシートをクリックしてアクティブ状態にしてから実行しないといけないのを、他シートがアクティブな状態でマクロ実行してしまったためではないかと思います。

ちなみに、標準モジュールに書いたマクロの保存ならば、マクロ編集画面で左のツリーから該当するモジュール（ダブルクリックすると、今使っているマクロが表示されるもの）を右クリックし、「ファイルのエクスポート」機能で名前を付けて保存しても良いです。今後環境が変わる等によりマクロが失われた場合は、同じようにツリーを右クリックしてから「ファイルのインポート」を使って読み込めばOK。
（???） 2017/12/06(水) 10:36

（γ）さん（Q::）さん（???）さん有難うございます
名前は下に表示されてたのですね。ようやく気付きましたｗ。

（Q::）さんのを試しますとやはり値が#REFとかなったりしてダメでした。
（???）さんの言う「アクティブ状態にしてから実行」という意味が分からなかったので
多分同じ事が原因なのかなと思いました。
只、（Q::）さんのをコピペした時に気づいたのですが、自動的にマクロ名がSub Macro12()
とかで出来上がるのですね。これがわかれば１２回コピペして１１月の所を１月から１２月
まで数字を変えてあげるだけなので望んでいたものが直ぐに作れます
有難うございました。

（hiro） 2017/12/07(木) 09:59

＞「アクティブ状態にしてから実行」という意味が分からなかったので

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1313238988
（Q::） 2017/12/07(木) 11:07

（Q::）さん有難うございます
「アクティブ状態にしてから実行」という意味がわかりました。
そうしますと今開いてるファイルでのマクロの結果、#REF　とかなってしまうので
やはり一丹貼り付け、値として再度貼り付け、それをコピペ縦横入れ替えて貼り付け
の作業が必要のようです。
只、今はもう１１月のマクロ名を１２個複写し１月から１２月まで変更しましたので
大丈夫です。
有難うございました。

（hiro） 2017/12/07(木) 11:34

コメント返信：

[ 一覧(最新更新順) ]

[[20171205115455]] 『マクロの複写について』（hiro） ページの最後に飛ぶ

[[20171205115455]]　『マクロの複写について』（hiro）　ページの最後に飛ぶ