• ベストアンサー

Excelで複数のマクロを一本化する方法

Macro5とMacro6を組み合わせて下記のような処理をさせたいのですが方法がわかりません。 お知恵をお貸しください。 1 日付を確認する 2 Macro6でコピー 3 日付にあわせてMacro5で貼り付け   今日が1日ならC14から貼り付け   2日ならC25から貼り付け   3日ならC36から貼り付け    ・      ・    ・   31日ならc344から貼り付け 作成したマクロ ' Macro5 Macro ' マクロ記録日 : 2007/4/25 ユーザー名 : ' ' Keyboard Shortcut: Ctrl+r ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub Sub Macro6() ' Macro6 Macro ' マクロ記録日 : 2007/4/25 ユーザー名 : ' ' Keyboard Shortcut: Ctrl+q ' Range("C2:AD12").Select Selection.Copy End Sub

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

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.3

Sub test01() Dim td, x td = Day(Date) x = (td - 1) * 11 + 14 MsgBox "今日は" & td & "日ですので、C" & x & "から貼り付けます。" With ActiveSheet .Range("C2:AD12").Copy .Range("C" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone End With End Sub

その他の回答 (3)

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.4

C2:AD12をコピーして、日付によって貼り付ける位置を変えて値として貼り付けるマクロです。日付を入力するセルは仮にC1としています。マクロに二行目を実際のシートに合わせて修正してください。 Sub Macro6plus5() Const DtAdrs As String = "C1" '日付が入るセルアドレス  If IsDate(Range(DtAdrs)) Then   ActiveSheet.Range("C2:AD12").Copy   ActiveSheet.Cells(Day(Range(DtAdrs)) * 11 + 3, "C").PasteSpecial Paste:=xlPasteValues   Application.CutCopyMode = False  Else   MsgBox ("日付型で日付を入力してください")  End If End Sub

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.2

こんな感じでしょうか? Sub test() Dim Hizuke As Integer Hizuke = (Day(Date) - 1) * 11 + 14 Sheets("sheet1").Activate Range("C2:AD12").Copy Sheets("sheet2").Activate Range("C" & Hizuke).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub

  • mshr1962
  • ベストアンサー率39% (7418/18948)
回答No.1

こんな感じでしょうか? Sub Macro7() Call Macro6 Cells(Day(Date) * 11 + 3, 3).Select Call Macro5 End Sub

関連するQ&A

  • Excel、マクロの記録、ショートカットキーが使えません

    Excelで下記のようにマクロの記録をしました。 1. Sub 改ページ() '表示-改ページのマクロです。 ' 改ページ Macro ' マクロ記録日 : 2009/11/26 ユーザー名 : ' ' Keyboard Shortcut: Ctrl+a ' ActiveWindow.View = xlPageBreakPreview End Sub 2. Sub 標準() '表示-標準のマクロです。 ' 標準 Macro ' マクロ記録日 : 2009/11/26 ユーザー名 : ' ' Keyboard Shortcut: Ctrl+z ' ActiveWindow.View = xlNormalView End Sub 3. Sub 改ページ範囲() '改ページ範囲を設定するマクロです。 ' 改ページ範囲 Macro ' マクロ記録日 : 2009/11/26 ユーザー名 : ' ' Keyboard Shortcut: Ctrl+q ' ActiveSheet.PageSetup.PrintArea = "$A$1:$P$27" End Sub ここで、1及び2についてはショートカットキーが使えるのですが、 3のショートカットキーを押しても何の反応もありません。 メニューバーのツール-マクロ-マクロのダイアログボックスを表示させてから、 「改ページ範囲」のマクロを選ぶと改ページされます。 そこで質問なのですが、 なぜ、ショートカットキーが使えないのでしょうか? よろしくお願いします。

  • エクセルのマクロについて質問(長文

    以前職場に居たIT講師の方が残していった抽選マクロなんですが、1度エクセルとは別のソフトで開いて同じ形式で上書き保存してしまったのですが、それ以来マクロが暴走してしまいます。 Sub 抽選() ' ' 抽選 Macro ' マクロ記録日 : 2003/12/11 ユーザー名 : ' ' Keyboard Shortcut: Ctrl+c ' Selection.Copy Range("A4:A58").Select Selection.PasteSpecial Paste:=xlAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A1:H1").Select End Sub 乱数はIの4~58に入っています。順位はJの4~58です。ボタンを押すと順位が乱数によってランダムに変わって、それによって当選マークがつくようになってました。 壊れたのでしょうが、どう壊れたのか、どう直せばいいのか分かりません。教えてください。

  • 値の貼り付けマクロが出来なくなりました。

    http://kokodane.com/macro17.htm 頻繁に、形式を選択して貼り付けで「値の貼り付け」を行うため、 上記のサイトを参考にしてマクロを作成しました。 コードは Sub 値の貼り付け() ' Keyboard Shortcut: Ctrl+t '   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _     SkipBlanks :=False, Transpose:=False End Sub です。 それが昨日のことなのですが、そのときはうまくマクロが動作して、 データを貼り付けることが出来ていたのですが、 今日やってみるとなぜかうまくいきません。 特に何か設定は変えていません。 セキュリティは下げた状態にしてあり、他のマクロは通常通り使えています。 コピーペーストは普通に行えています。 なぜなんでしょうか? 何度かマクロを作成しなおしてみたりもしたのですが、 どうやってもうまくいきません。 どなたか理由を教えて下さい。

  • Excelマクロ教えてください。

    いつも大変お世話になっております。 あるシートにあるフォントのすべてをMSゴシックにしたいのですが、 マクロ記録→全選択してフォント変更→記録解除 で下記のマクロができました。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/11/21 ユーザー名 : TEST ' ' Cells.Select With Selection.font .Name = "MS ゴシック" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With End Sub 全選択せずに、あるシートすべてのフォントを変更する方法はありますか? シートのフォントを変更するだけの目的です。 よろしくお願いします。

  • EXCELのマクロについて

    お世話になっております。 以下のマクロを1万行分繰り返したいのですが、回数を1万回と指定する構文を 教えてください。よろしくお願いします。 Sub Macro16() ' ' Macro16 Macro ' ' Keyboard Shortcut: Ctrl+Shift+Z ' ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ActiveCell.Offset(-1, 0).Range("A1:M1").Select Selection.Copy ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste ActiveCell.Offset(-1, 2).Range("A1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "7/5/1905" ActiveCell.Offset(1, 0).Range("A1").Select ActiveCell.FormulaR1C1 = "7/6/1905" ActiveCell.Offset(1, -2).Range("A1").Select End Sub

  • エクセルのマクロ セルの結合プロシージャを教えてください。

    マクロの記憶でのプロシージャを Rangeを変数型にしたいのです。 行も列も定めまずに、範囲はA1:BX45です。 Offsetを使うのか、もう何がなんだかわからないので 教えてください!! マクロの記憶でのプロシージャです。 ↓ Keyboard Shortcut: Ctrl+d ' End Sub Range("R26:T27").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = True .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge End Sub

  • 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>に貼り付けることができるように するにはどのようにマクロを修正すればよろしいでしょうか。

  • Excelのマクロで現在行を指定する方法を

    Excelのマクロで現在行を変えて、現在見ている行にする方法を教えてください。 下記は操作を記録させて作成したものですが、これを例えば、Excelの213行で実行させると 205行に196~203行が再度追加されてしまいます。 これを変えて、現在見ている例えば213行の前に196~203行を入れたいという場合はどうすればいいのでしょうか? つまり、Rows("205:205").Selectの205というのを、現在見ている行に変更できれば良いように思うのですが。よろしくお願いします。 Sub Macro3() ' Keyboard Shortcut: Ctrl+Shift+A   Rows("196:203").Select   Selection.Copy   Rows("205:205").Select   Selection.Insert Shift:=xlDown   ActiveWindow.SmallScroll Down:=9 End Sub

  • 列幅、行の高さを指定するマクロ

    元マクロ初心者(今はほとんど忘れています)です。 列幅、行の高さを変更するマクロを以前作りました。 セルに指定する列幅を入力するのですが、 最近100以上の値の時はスキップされることに気づきました。 100以上の値でも処理されるようにするにはどうすればよいでしょうか。 Sub 列幅変更マクロ() ' ' Macro1 Macro ' マクロ記録日 : 2004/1/31 ユーザー名 : ' 列幅の変更 ' Keyboard Shortcut: Ctrl+l ' If MsgBox("→:列幅を変更します。右の方向にセル内の数値に従って処理しています。一番右のセルに半角で「@」を終わりの印として入力してください。", vbOK) = 1 Then Do Until ActiveCell.Value = "@" If ActiveCell.Value < 100 Then If ActiveCell.Value > 0 Then Selection.ColumnWidth = ActiveCell.Value End If End If ActiveCell.Offset(0, 1).Select Loop End If End Sub Sub 行の高さ変更マクロ() ' ' Macro2 Macro ' マクロ記録日 : 2004/2/1 ユーザー名 : ' 行の高さ変更 ' Keyboard Shortcut: Ctrl+p ' If MsgBox("↓:行の高さを変更します。下の方向にセル内の数値に従って処理しています。一番下のセルに半角で「@」を終わりの印として入力してください。", vbOK) = 1 Then Do Until ActiveCell.Value = "@" If ActiveCell.Value < 100 Then If ActiveCell.Value > 0 Then Selection.RowHeight = ActiveCell.Value End If End If ActiveCell.Offset(1, 0).Select Loop End If End Sub

  • マクロの自動記録について

    Sub Macro1() 'Macro1 Macro 'Keyboard Shortcut:Ctrl+a Application.Run"ATPVBAEN.XLA!Sample",Worksheets("sheet1").Range("$A$2:$AD$31"),ActiveCell,"R",10,False ActiveCell.Offset(0,1).Select End Sub  これは、マクロの自動記録を用いて、『ツール>分析ツール>サンプリング』の動作を自動的に生成されたマクロ(プログラム)を書き直したものです。  このマクロを実行しようとすると、『実行時エラー'1004':'ATPVBAEN.XLA'が見つかりません。ファイル名およびファイルの保存場所が正しいか確認してください。』と出て、マクロが実行できません。どうすればよいでしょうか?

専門家に質問してみよう