VBAの実行方法についての質問

前へ 次へ
このQ&Aのポイント
  • VBAを使ってワークシートの印刷時に特定の条件に応じて値をワークシートに貼り付けたいです。具体的には、印刷するシートのセルM1の値に応じて、貼り付け先を変えるようにしたいです。
  • 現在のコードでは、ワークシート日報への値のみ貼り付ける部分を少し変更したいです。具体的には、M1の値が1ならばワークシート日報のF5に、2ならばF6に、3ならばF7に、というようにしたいです。
  • どのようにコードを変更すれば、指定した条件に応じてワークシートに値を貼り付けることができるでしょうか？
回答を見る
  • ベストアンサー

印刷後のVBAの実行(4)

Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "顧客データー1" Then If Range("D1").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D1").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("顧客データー1").Range("D6") = "不可" Or _ Worksheets("顧客データー2").Range("D6") = "不可" Then GoTo P1 ActiveSheet.Range("F650:O650").Copy If Worksheets("日報").Range("F5").Value = "" Then Worksheets("日報").Range("F5").PasteSpecial Paste:=xlPasteValues Else Worksheets("日報").Range("F65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub 現在上記コードを使っていますが、ワークシート日報への値のみ貼り付けの部分で少し変更したいのですが、印刷するシートのセルM1の値が1ならそのシートのRangeF650:O650をコピーしてワークシート日報のF5に値のみで貼り付け、M1の値が2ならF6に、M1の値が3ならF7に・・・という感じでM1の数字の値によってワークシート日報へ貼り付け先を変えていくようしたいのですが、どのようにコードを変更したらいいでしょうか?

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

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

Worksheets("日報").Range("F5")の状態にかかわらず、 M1が1⇒F5 M1が2⇒F6 M1が3⇒F7　とM1の値＋4　の行（F列）を基点に貼り付けるんですね？ Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name <> "顧客データー1" Then Exit Sub With ActiveSheet If .Range("D1").Value = "" Then Cancel = True MsgBox ("名前を入力してください") .Range("D1").Select Exit Sub End If If Worksheets("顧客データー1").Range("D6") = "不可" Or _ Worksheets("顧客データー2").Range("D6") = "不可" Then GoTo P1 .Range("F650:O650").Copy r = .Range("M1").Value + 4 Worksheets("日報").Range("F" & r).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False P1: .Range("A1").Select End With End Sub

masa1717
質問者

お礼

出来ました、r = .Range("M1").Value + 4,Worksheets("日報").Range("F" & r).PasteSpecial Paste:=xlPasteValuesがなんかポイントみたいですね、ありがとうございます

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • 印刷後のVBAの実行　(3)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします

  • 印刷後のVBAの実行　(2)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) 　　If ActiveSheet.Name = "Sheet1" Then 　　　　If Range("D6").Value = "" Then 　　　　　　Cancel = True 　　　　　　MsgBox ("名前を入力してください") 　　　　　　Range("D6").Select 　　　　　　Exit Sub 　　　　End If 　　Else 　　　　If ActiveSheet.Name = "Sheet2" Then 　　　　　　If Range("C11").Value = "" Then 　　　　　　　　Cancel = True 　　　　　　　　MsgBox ("受付時間を入力してください") 　　　　　　　　Range("C11").Select 　　　　　　　　Exit Sub 　　　　　　End If 　　　　Else 　　　　　　 　　　　　　Exit Sub 　　　　End If 　　End If 　　ActiveSheet.Range("A70:Y70").Copy 　　If Worksheets("Sheet3").Range("A1").Value = "" Then 　　　　Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues 　　Else 　　　　Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ 　　　　　　Paste:=xlPasteValues 　　End If 　　Application.CutCopyMode = False 　　ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23～30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?

  • VBA beforeprintについて

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "sheet1" Then If Range("M1").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("M1").Select Exit Sub End If ElseIf ActiveSheet.Name = "sheet2" Then If Range("A47").Value = 文字 Then Cancel = True 　　 MsgBox ("日付を入力してください") Range("A47").Select Exit Sub End If Exit Sub End If End Sub 上記は印刷をする前に実行されるコードですが、上記を実行して印刷をした後に自動で下記のVBAを実行したいのですが Sub データー取り込み() ActiveSheet.Range("B2000:Z2000").Copy ChDir "\\データーA\データーB\データーC\データーD" Workbooks.Open Filename:="\\データーA\データーB\データーC\データーD\データーシート1.xls" Sheets("顧客データー").Select If Worksheets("顧客データー").Range("B18").Value = "" Then Worksheets("顧客データー").Range("B18").PasteSpecial Paste:=xlPasteValues Else Worksheets("顧客データー").Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If ActiveWorkbook.Save ActiveWindow.Close End Sub 上記のコードと下記のコードをどのように絡めたらいいのかわかりません。アドバイスお願いします。

  • EXCEL　マクロ　

    お世話になります。 マクロは初心者です。 セルの数値を参照して、シートをアクティブにしたいのですが 下記のような繰り返しでシートが30ぐらいあるので、簡単な 表現に出来ないでしょうか。 宜しくお願いします。 Private Sub Workbook_Open() If 0 <= Worksheets(4).Range("M1") < 7 Then Worksheets(4).Activate End If If 0 <= Worksheets(5).Range("M1") < 7 Then Worksheets(5).Activate End If If 0 <= Worksheets(6).Range("M1") < 7 Then Worksheets(6).Activate End If If 0 <= Worksheets(7).Range("M1") < 7 Then Worksheets(7).Activate End If If 0 <= Worksheets(8).Range("M1") < 7 Then Worksheets(8).Activate End If If 0 <= Worksheets(9).Range("M1") < 7 Then Worksheets(9).Activate End If End Sub

  • VBA　ある条件を満たしてからの実行

    Sub 登録() ActiveSheet.Range("F650:T650").Copy r = Range("M1").Value + 4 Worksheets("データ管理").Range("F" & r).PasteSpecial Paste:=xlPasteValues End Sub 上記を実行する前に条件を入れたいのですが、 セルA1に名前(もしくはなんからの文字)が入っていなかったら、MsgBox ("名前を入力してください")、 セルA2に住所(もしくはなんからの文字)が入っていなかったら、MsgBox ("住所を入力してください")、 この条件をみたしてから上記をマクロを実行したいんですが・・・ アドバイスお願いします

  • VBA空白を除いてコピーが出来ません。ご指導お願いします。

    値のコピー＆ペースト（空白を除いてコピー）したいと思っております。 シート１　の　A35、D35、I35　をコピー。 シート２　の　A2　に貼り付け。 これは、大丈夫です。 シート１　の　M2　：　O23　をコピー。 シート２　の　E2　に貼り付け。 今回の場合ですと、M2　：　O13　までに値が入ってます。 ですので、M14　：　O23　までが、空白になって記入となってしまいます。 ＊毎回、値が入る量が違います。 一回のコピーですと、これでもいいのですが、 値を変更して、コピーを続けてしますので、M14　：　O23　までが、空白になってM24からのコピーになってしまいます。 空白を除いて、貼り付けしたいのですが、 どうすればいいのかわかりません。 お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。

  • 実行時エラー'1004'で困っています。

    少し前にも同じコードの他の点についてアドバイスをいただいたのですが、新たな問題点が生じたので改めて質問させてほしいです。 具体的な問題点が分からなかったのでコードをそのまま載せました。 シート1に値を入力すると、繁殖牛データ。データ。という２個のシートから検索し、リンクをつけたいです。 繁殖牛データシートに入っている値を入力した時は ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'繁殖牛データ'!" & Range(Cells(kennsaku, 3)) データシートに入っている値を入力した時は ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!" & Range(Cells(kennsaku, 1)) で「'Range'メソッドは失敗しました：'_Worksheet'オブジェクト」とでます。 試験的にどちらのシートにも入っていない値を入力すると、思惑通りに"見つからないのでリンクは貼りません"と帰ってきます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim kennsaku, y, z If Target.Count > 1 Then Exit Sub 'セルを二つ以上選択した場合 If Target.Value = "" Then Exit Sub 'データが空の場合 If Application.CountIf(Range("A1:Z80"), Target.Value) > 1 Then MsgBox Target.Value & "は既に入力されています", vbOKOnly + vbExclamation Target.Clear Exit Sub End If Set y = Worksheets("繁殖牛データ").Range("$C$1:$C$1003") Set z = Worksheets("データ").Range("$A$1:$A$65536") kennsaku = Application.Match(Target.Value, y, 0) If IsNumeric(kennsaku) Then ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'繁殖牛データ'!" & Range(Cells(kennsaku, 3)) Else kennsaku = Application.Match(Target.Value, z, 0) If IsError(kennsaku) Then MsgBox "見つからないのでリンクは貼りません", vbOKOnly + vbExclamation Exit Sub Else ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!" & Range(Cells(kennsaku, 1)) End If End If Range("A1:Z80").Font.Underline = False End Sub

  • Excel VBA Rangeについて

    下記のコードは、あるテキストに掲載されていたコードです。 D5に番号を入力すると、F5に文字が表示されるというようなコードです。 下記コードのRange("顧客コード")とは何を意味するのでしょうか？ Worksheets("顧客")の意味は分かりますが、私の知識ではRange("　")の中に入るのは、A1などしか分かりません。 よろしくお願いします。 Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Integer, myRange As Range Set myRange = Worksheets("顧客").Range("顧客コード") With Target '変更されたセルがD5だったら If .Row = 5 And .Column = 4 Then '顧客コードの位置を取得 r = Application.WorksheetFunction _ .Match(Target.Value, myRange, 0) 'セルに顧客名を表示 Range("F5") = Worksheets("顧客").Range("B1").Offset(r - 1).Value End If End With End Sub

  • VBAで印刷処理の設定

    メインシートで、印刷ボタンを押した際に、 設定値に基づいて、条件分岐するには、どうすればいいでしょうか。 ご教授お願いいたします。 ★シート名 ・メインシート ・名簿 ・設定 の３つのシートがあります。 メインシートには、入力項目があります。 名簿には、 No. 会社名 担当 印刷 ・ ・ ・ のセルがあります。 印刷列は、 「0」or「1」の指定がされています。 0の場合は、印刷しない。 1の場合は、印刷する。 設定シートには、 項目 値 列があります。 項目1には、「プレビュー表示」があり、 値には、「プレビュー表示する」or「プレビュー表示しない」が 設定されます。 Sub 連続印刷() Dim i As Integer Dim LastRow As Integer Worksheets("メインシート").Select With Worksheets("名簿") LastRow = .Range("A65536").End(xlUp).Row For i = 2 To LastRow Range("A4").Value = .Range("A" & i).Value ' プレビュー表示分岐 With Worksheets("設定") ' Cells(行番号, 列番号) If Cells(2, 2).Value = "1" Then ' プレビュー確認 ActiveSheet.PrintPreview ElseIf Cells(2, 2).Value = "プレビュー表示しない" Then ' 確認なしで印刷 ActiveSheet.PrintOut Else ' プレビュー確認 ' ActiveSheet.PrintPreview MsgBox ("test") End If End With Next End With End Sub

  • 印刷した後のVBAの実行

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If (ActiveSheet.Name = "sheet1") And ((Range("D6").Value = "")) Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select ElseIf (ActiveSheet.Name = "sheet2") And ((Range("C11").Value = "")) Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select End If End Sub 今上記のコードで印刷制御をしていますが これに追加をしたいのですが 例えば上記の条件を満たしてsheet1を印刷した後 sheet1のA70:Y70の範囲(この部分には関数が入ってます)をCopyして sheet3のA1:Y1に値のみで貼り付けて 最後にsheet1のA1を選択して終了 次に同じ様に 条件を満たしてsheet2を印刷した後 sheet2のA70:Y70の範囲(この部分にも関数が入ってます)をCopyして 今度はsheet3のA2:Y2に 値のみで貼り付ける (→ここが重要なんですが、この部分はもしsheet3のA1に情報が入力されてたら、sheet3のA2:Y2に貼り付ける、 A1が空白ならsheet3のA1:Y1に貼り付けるという風に、貼り付ける初めの部分をA1:Y1として、情報が入力されていたらその下の行の情報の入力されてない範囲に貼り付ける・・・という形にしたいのですが) そしてsheet2のA70:Y70の範囲をdeleteして 最後にsheet2のA1を選択して終了 印刷ボタンを押してsheetを印刷した後、この部分を自動で実行するようにVBAで追加を組めるでしょうか？ 素人なのでよく分かってないんですが、回答お願いします

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する