• ベストアンサー
  • 困ってます

エクセルVBAで作成した別ブックにVBAを記述したい

VBAで別ファイルの作成は下記で出来ているのですが、出来上がったファイルにVBAを記述する方法がわかりません。 具体的には一番下のSub TEST()を新しいブックの標準モジュールに記述したいのと、sheet1に Private Sub Worksheet_Change(ByVal Target As Range) MsgBox "ChangeTEST" End Sub を入れたいです。 また Private Sub Workbook_Open() MsgBox "OpenTEST" End Sub も入れたいのです。 どうぞご教示ください。 Sub 複製() Dim wb As Workbook, sc As Integer sc = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set wb = Workbooks.Add Application.SheetsInNewWorkbook = sc wb.Sheets("Sheet1").Select ThisWorkbook.Sheets("Sheet1").Cells.Copy wb.Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Buttons.Add(123, 195, 68.25, 15).Select Selection.OnAction = "TEST" Selection.Characters.Text = "TEST" ActiveWorkbook.Close ThisWorkbook.Activate Sheets("Sheet1").Select End Sub Sub TEST() MsgBox "TEST!!" End Sub よろしくお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数1133
  • ありがとう数5

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.1

わたしも前前からやってみたいと思っていたので、ネットを検索して調べてみました。 こんな感じで出来るようです。 'マクロ挿入 With wb.VBProject.VBComponents.Item("ThisWorkbook").CodeModule .InsertLines 1, "Private Sub Workbook_Open()" .InsertLines 2, "" .InsertLines 3, "   Msgbox""ブックが開かれましたよ!""" .InsertLines 4, "" .InsertLines 5, "End Sub" End With With wb.VBProject.VBComponents.Item("Sheet1").CodeModule .InsertLines 1, "Private Sub Worksheet_Change(ByVal Target As Range)" .InsertLines 2, "" .InsertLines 3, " MsgBox ""セルの値が変更されましたよ!""" .InsertLines 4, "" .InsertLines 5, "End Sub" End With wb.VBProject.VBComponents.Add (1) 'Module1挿入 With wb.VBProject.VBComponents.Item("Module1").CodeModule .InsertLines 1, "Sub TEST()" .InsertLines 2, "" .InsertLines 3, "   Msgbox""TESTしたよ!""" .InsertLines 4, "" .InsertLines 5, "End Sub" End With

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございました。 出来ました。

関連するQ&A

  • エクセルマクロ 繰り返して、別のシートへコピーしたい

    エクセルマクロ 繰り返して、別のシートへコピーしたい マクロ初心者のため、やり方が全くわかりません。 どなたか教えてください。 やりたいことは、 コピーするシートはあらかじめ作成しています。 簡素化の方法がわからないので、 とりあえず自分で作ってみたものが下にあるものです。 繰り返す方法がわからないので、 どなたか教えてください。 よろしくお願いします。 以下、作成したマクロです。 1行目から10行目まで繰り返したくて、 1行目から2行目のセルの移動の差は10行目までかわりません。 '1行目 Sheets("Sheet1").Select Range("B14:C14").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B15:C17").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False '2行目 Sheets("Sheet1").Select Range("B18:C18").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B19:C21").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False

  • Excel 繰り返しマクロ

    下記のようなマクロを使ってn個あるシートの内容を「集計」シートにコピーさせるようにしました。 (自動マクロとの組合せなので、スマートではないかもしれませんが) でも、これだと「集計」シートもコピー作業を行ってしまうので、 「集計」シートはコピー作業をしないように除外したいのですが、どうしたら良いのでしょう? 実際にはシート数は30程度、コピペ項目は1シートあたり30項目程度あります。 よろしくお願いします。 ------------------------- Sub テスト2() ' For i = 1 To Worksheets.Count '案件番号等コピー ' Sheets(i).Select Range("D3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '案件名 Sheets(i).Select Range("F3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '国名 Sheets(i).Select Range("E3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("C4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '選択セルの解放 Application.CutCopyMode = False '行挿入 ' Sheets("集計").Select Rows("4:4").Select Selection.Insert Shift:=xlDown Next i End Sub

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1(A9) → sheet2(C2) sheet1(E9) → sheet2(C5) sheet1(I9) → sheet2(C8) ●項目1 sheet1(A8) → sheet2(E3) sheet1(E8) → sheet2(E6) sheet1(I8) → sheet2(E9) ●項目2 sheet1(A18~D18の結合セル) → sheet2(E2) sheet1(E18~H18の結合セル) → sheet2(E5) sheet1(I18~L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか?? ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

その他の回答 (1)

  • 回答No.2

もう答えは出ていますが、ひとつだけ。 マクロをボタンにはりつける Selection.OnAction = "TEST" ですが、作成先である新しいブックの名前まで入れないと作成元のブックのマクロにリンクされてしまうようですよ。念のため。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご親切にありがとうございました。 ええ、ためしたところそうでした。 たすかります。

関連するQ&A

  • Excel 2007 マクロ 表の貼り付け

    Excel 2007 マクロ 表の貼り付け Excel 2007 マクロ 表の貼り付けについて教えてください。 <Sheet1>の表にあるA2からD4を <Sheet2>に値貼り付けをします。 表は画像を添付します。 マクロの記録では下記内容になります。 Sub Macro1() ' ' Macro1 Macro ' ' Range("A2:D4").Select Selection.Copy Sheets("Sheet2").Select Range("A2:D4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub <Sheet1>のA列の行の増減にかかわらず、<Sheet2>に貼り付けることができるように するにはどのようにマクロを修正すればよろしいでしょうか。

  • エクセルVBAで空白セルを削除する方法

    みなさん教えてください。 今エクセルVBAで、下記のようにのA列に空白セルがある場合にそのセルを削除し、 空白セルが無い場合何もしないと言うマクロを作っています(下記のように自動記録し ました)。 しかし、作成したマクロは、下記のようにA列に空白セルがない場合はエラーが出てし まいます。 空白セルが無い場合エラーが出ない方法を教えて頂けないでしょうか。 よろしくお願いします。 <マクロ> Sub Macro1() Columns("A:A").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.SpecialCells(xlCellTypeBlanks).Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp End Sub <データ> A --------- 1 2 1 1 1 3 4 ・ ・ ・ (以降約300行続きます)

  • Excel マクロのループ処理の高速化

     0 ,10 ,20 ,30 ,40 ,50 ,60 ,70 ,80 ,90 ,100 という11種類の数値が、1000個あります。 (1)1000個の数値を収めた列からC6:C20 に20 個無作為抽出し、コピーして E6:E20 にペーストします。 (2)このとき、C6:C20 には新たな数値が20 個無作為抽出されます。 (3)E6:E20 のデータを G6:Z6 にペーストする。  以上を1000回繰り返します(G6&#65374;G1005:Z6&#65374;Z1005)。1回実施してマクロ登録して、以下のように少し訂正して実施したのですが、高々1000個のデータなのに1分以上かかります。画面がちらついて計算の様子が表示されるので遅いのでしょうか? 高速化できる方法を教えてください。 Sub Macro1()   For N = 1 To 1000     Range("C6:C20").Select     Selection.Copy     Range("E6").Select     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _       :=False, Transpose:=False     Application.CutCopyMode = False     Selection.Copy     RangeStr = "G" & CStr(N + 5) & ":" & "Z" & CStr(N + 5)     Range(RangeStr).Select    'N=1 ⇒ Range("G6:Z6").Select     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _       False, Transpose:=True   Next N End Sub

  • VBAでブックの集計の仕方を教えてください。

    H22.12月度と言う名前のフォルダーにA店&#65374;E店と集計と言う名前のブックがあります。 集計のブックでA店&#65374;E店の集計をしてくるマクロを組んでいますが上手く作動しません。 集計のブックには、セルの書式設定をしていますので、A店&#65374;E店の売上一覧のシートから 値だけをコピーして集計したいのですが、罫線やパターン、数式までコピーしてきたり、 最後のE店だけ2重にコピーしてきたりと変な動作をします。 初心者で本やネットで調べながら作ったので、どこの記述がおかしくて、そうなるのかがさっぱりわかりません。 どなたか教えていただけませんでしょうか。よろしくお願いします。 Sub 集計() Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\A店.xls" Sheets("売上一覧").Select Range("E5:Q24").Select Selection.Copy Application.WindowState = xlMinimized Windows("集計.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False If Range("E5").Value <> "" Then Range("E65536").Select Selection.End(xlUp).Select Selection.Offset(1, 0).Select End If ActiveSheet.Paste Windows("A店.xls").Activate Range("E5").Select Application.CutCopyMode = False ActiveWindow.Close     ・     ・     ・(B・C・D店も同じ記述)     ・     ・   Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\E店.xls" Sheets("売上一覧").Select Range("E5:Q24").Select Selection.Copy Application.WindowState = xlMinimized Windows("集計.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False If Range("E5").Value <> "" Then Range("E65536").Select Selection.End(xlUp).Select Selection.Offset(1, 0).Select End If ActiveSheet.Paste Windows("E店.xls").Activate Range("E5").Select Application.CutCopyMode = False ActiveWindow.Close    Windows("集計.xls").Activate Application.WindowState = xlMaximized Range("E5").Select End Sub

  • エクセルVBA マクロの記録をコマンドボタンにコピペしても動かないのはなぜ?

    マクロを記録した以下は問題なく動くのですが、 Sub Macro1() Sheets("AAA").Select Range("A39:AQ39").Select Selection.Copy Sheets("BBB").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub これをシート”BBB”のコマンドボタンに下記のようにコピペすると Range("A39:AQ39").Selectでエラーが発生し動きません。 どうすれば動くようになるのでしょうか? また、どうしてボタンだとコピペするだけではいけないのでしょうか? Private Sub CommandButton1_Click()    ここにコピペ End Sub

  • Excelのマクロ(VBA)について教えてください。

    このようなマクロをつくりたいのですがうまく作れません。 セルをコピーした後、貼り付け先のセルを選択して、 <ここからがマクロ> 形式を選択して貼り付け→罫線を除くすべて <マクロ終了> 他の貼り付け方法はうまくできるのですが、「罫線を除くすべて」だけができません。 参考までにこれが作られたVBAです。 Sub Macro1() Selection.PasteSpecial Paste:=xlAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End Sub 以上です。 どなたかアドバイスよろしくお願いします。

  • Excelでマクロを繰り返したい。

    Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

  • エクセルでVBAショートカットを作成したいです

    エクセルVBAを使用して、ショートカットキーを作成したいです。 ネットで調べてみた情報を元に、以下のようにマクロを作成しましたが、動作しません。 (やろうとしているのは、Ctrl+Shift+V で値で張り付け です) どのように直したら動作するか教えて頂きたいです。 以下、作成したマクロです。。。 ---------------------------------------------------------------------- Sub auto_open() Application.OnKey "+^V", "値で張り付け" End Sub Sub 値で張り付け() Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub ----------------------------------------------------------------------

  • シート1のC列の最終行をコピーして同じ行に値貼り付けしたい

    シート1のC列の最終行を取得して その行を丸々値貼り付けするマクロを作りたいと思います。 シート3のB18の値をシート1のC列の最終行の1つ下のセルに値貼り付け すると、その行のA、B列に日付が入力される関数が入っています。(下まで) 関数が入ったままだと、うまくいかない時があるので最終行をコピーして値貼り付けしたいのですが、マクロの作り方を教えてください。 シート1の最終行に貼り付け Sheets("Sheet3").Select Range("B18").Select Selection.Copy Sheets("Sheet1").Select Range("C65536").End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub 最終行をコピーして値貼り付け Dim 最終行 As Integer 最終行 = Range("C65536").End(xlUp).Row Range("A6:C" & 最終行).Select Selection.Copy Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub このマクロだと、A6からC列の最終行まで全てコピーされてしまうので、C列の最終行のAからC列まで1行だけコピーできないでしょうか?

  • vba 不揃いの行数にカーソル位置対応

    os_xp //// ex_2003 Sub goo() ' goo Macro ' Keyboard Shortcut: Ctrl+g ' Range("A65524").Select Selection.End(xlUp).Select Rows("669:669").Select '(1)-----次回及び 他のシートは不揃いの為 Selection.Copy Rows("670:670").Select '(2)-----(1)が位置が変化するからここも対応 ActiveSheet.Paste Application.CutCopyMode = False Range("A669:F669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("BD669:BG669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("A672").Select '(3)-----次回及び 他のシートは不揃いの為 最後に記録の2段下にカーソルが来て欲しい End Sub ' 'どのシートでも (1) (2) (3) が対応してくれないか?。 '