- ベストアンサー
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 ("住所を入力してください")、 この条件をみたしてから上記をマクロを実行したいんですが・・・ アドバイスお願いします
- masa1717
- お礼率60% (35/58)
- オフィス系ソフト
- 回答数2
- ありがとう数4
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
VBAは得意ではないですが、 Sub 登録() If Range("a1").Value = "" Then MsgBox "氏名を入力してください" Range("a1").Activate Else If Range("a2").Value = "" Then MsgBox "住所を入力してください" Range("a2").Activate Else ActiveSheet.Range("F650:T650").Copy r = Range("M1").Value + 4 Worksheets("データ管理").Range("F" & r).PasteSpecial Paste:=xlPasteValues End If End If End Sub
その他の回答 (1)
- 某HN クロメート(Chromate)（@CoalTar）
- ベストアンサー率40% (705/1742)
こんな感じかなあ Sub 登録() Dim ABC As String Dim BBC As String If Range("A1").Value = "" Then ABC = "名前を入力してください" & Chr(13) If Range("A2").Value = "" Then BBC = "住所を入力してください" If ABC & BBC <> "" Then MsgBox ABC & BBC Exit Sub End If MsgBox "OK" End Sub 参考まで
お礼
参考にしてみます ありがとうございます
関連するQ&A
- 印刷後の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の実行(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の数字の値によってワークシート日報へ貼り付け先を変えていくようしたいのですが、どのようにコードを変更したらいいでしょうか?
- ベストアンサー
- オフィス系ソフト
- Excel2003のＶＢＡで教えてください
以下のようなコードのプログラムを書いています。 使用しているシートは、"data"と"入力"という２つのシートです。 "入力"シート上で入力したデータを"data"シート上に追加していく予定です。 しかし、どうしても、"入力"シート上にペーストされてしまい"data"シート上にペーストすることができません。 Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues が問題だとおもうのですが、これを Range("data!A" & z + 1).PasteSpecial Paste:=xlPasteValues と変更すると、実行時エラー1004になってしまいます。 アドバイスお願いします Private Sub CommandButton1_Click() Dim n As Integer Dim z As Long n = WorksheetFunction.CountA(Range("b9:b23")) Range("b51:f" & 51 + n - 1).Copy Set data = Worksheets("data").Range("A1") z = data.Rows.Count Sheets("data").Select Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues MsgBox "登録しました" End Sub
- ベストアンサー
- その他（プログラミング・開発）
- 印刷後の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 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 上記のコードと下記のコードをどのように絡めたらいいのかわかりません。アドバイスお願いします。
- ベストアンサー
- オフィス系ソフト
- このVBAの処理を速くしたいのですが…
お世話になります data.xlsmとBook1-Book25.xlsxの 合計26ファイルを開いた状態で 以下のマクロを実行しています 私が使っているマシンでは 10分くらいかかるのですが この時間を短くすることは 出来ますでしょうか？ Sub copy() Application.ScreenUpdating = False Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1:D1048576").copy Workbooks("data.xlsm").Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues Range("G1:K1048576").Clear Range("A1:E1048576").copy Range("G1:K1048576").PasteSpecial Paste:=xlPasteValues Range("I2").ClearContents Range("I1048576").End(xlUp).ClearContents Range("A2:D1048576").Clear Range("O1:Q1").copy Range("S1048576").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues あとは上記をBook2,Book3と変えてBook25まで同じ式を記入 End Sub
- ベストアンサー
- Excel（エクセル）
- Excel2007 VBA 転記について
ご指導のほどお願いします。 見積書からボタン300をクリックするとＦＡＸ送付状（テンプレート）.xlsに下記内容が転記するように書いたのですが、質問させてください。 ("見積書").Range("c6")→("Sheet1").Range("e14")に貼り付けはうまく行きますが 本当は("見積書").Range("c6")＆("見積書").Range("c8")=&"の件"を("Sheet1").Range("e14")に貼り付けしたいのです。 C6セル「○○○工場」 C8セル「○○○作業」 の件 ↑をE14セルに「○○○工場 ○○○作業の件」 として貼り付けたいです。 Sub ボタン300_Click() Workbooks.Open "\FAX送付状\ＦＡＸ送付状（テンプレート）.xls" ThisWorkbook.Worksheets("見積書").Range("a4").Copy Workbooks("ＦＡＸ送付状（テンプレート）.xls").Worksheets("Sheet1").Range("f6").PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("見積書").Range("i8").Copy Workbooks("ＦＡＸ送付状（テンプレート）.xls").Worksheets("Sheet1").Range("AD9").PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("見積書").Range("c6").Copy Workbooks("ＦＡＸ送付状（テンプレート）.xls").Worksheets("Sheet1").Range("e14").PasteSpecial Paste:=xlPasteValues ActiveSheet.Range("F9").Value = Date End Sub ご指導のほどお願いします。
- ベストアンサー
- その他MS Office製品
- VBA Pasteで教えて下さい！
Book1で指定したセル範囲(C2:C41)を Book２のSheet1の（AB4:AB43）とSheet2の（AU10:AU49）にペーストを行うに あたり、ボタン押下にて実行する下記コードをBook1に作成しましたが、 ２番目のPasteで実行時エラー1004「アプリケーション定義または オブジェクト定義のエラーです」と出ます。 複数Sheetの別々のセルにペーストする方法を 教えていただけないでしょうか？ Book1とBook２は共に開いた状態です。 Book２のシートは、それぞれVBAで保護をかけていますが、 .protect UserInterfaceOnly:=Trueで変更可能な状態に しています。 Private Sub copy_Click() Range("C2:C41").Copy Windows("Book2").Activate Sheets("Sheet1").Range("AB4:AB43").PasteSpecial Paste:=xlPasteValues Sheets("Sheet2").Range("AU10:AU49").PasteSpecial Paste:=xlPasteValues （↑ここでエラーが出ます） End sub
- ベストアンサー
- Visual Basic
- VBAでオートフィルタ抽出後コピペ
VBA初心者で勉強中の者です。 『工事台帳シート』からオートフィルタで抽出したものを、『工事別表示シート』にコピペするコードをつくりました。 以下のものです。 Sub 工事抽出コピペ() Dim Obj As Object With Sheets("工事台帳") Set Obj = .Range("E5:E65536").Find(.Range("E2"), LookAt:=xlWhole) If Obj Is Nothing Then MsgBox "見つかりませんでした。" Sheets("工事別表示").Range("B11:F65536").ClearContents Exit Sub Else .Range("B6").AutoFilter Field:=4, Criteria1:=.Range("E2").Value .Range("F5:J65536").Copy End If End With Sheets("工事別表示").Range("B11").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub これを起動させると、 Sheets("工事別表示").Range("B11").PasteSpecial Paste:=xlPasteValues の部分が黄色くなり、 実行時エラー'1004'「コピー領域と貼付領域の形が違うため、情報を貼り付けることができません」 という表示が出てきます。 これはどういう意味なのでしょうか？ ちなみにコピー領域セルも貼付領域セルも結合はなく、行・列の幅も同じです。 このコードもいろいろな本やサイトで教えてもらったのを参考に作っているので、私自身深く理解せずに書いているところもあります。 どなたか教えてくださる方、よろしくおねがいします。
- ベストアンサー
- オフィス系ソフト
- Excelの三つのVBAを一つにまとめる。
初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ 解る方、よろしくお願いします。
- 締切済み
- オフィス系ソフト
お礼
出来ました ありがとうございます