**NO４**
「見積書」のデータのセルの黄色の入力部分は「データ見積」の２行目に入るように式を設定しています。 1行目と２行目と8行目は非表示にしています。 1行目と8行目は分かりやすいように項目名と番号を、実際のデータはセルＢ２からセルＤＥ２まで。「見積書」のセルＧ１に表示される数字がデータの登録整理番号となります。「ＤＡＴＡ見積」に「見積書」のデータは9行目から順番に登録するように設定しています。新規登録の位置は　次のマクロでセルＧ１には　=DATA見積!A2+1　　という式が入力されます。 DATA見積!A2　　には　=COUNT(B9:B1008)　　の式があるので、いまあるデータの次の番号になります。 ' Range("G1").Select ActiveCell.FormulaR1C1 = "=DATA見積!R[1]C[-6]+1" Range("G2").Select データの保存のマクロです。 2行目のデータをすでにあるデータの次の行に値のみ貼付けをします。 Dim 位置 As Integer 位置 = Sheets("見積書").Cells(1, 7).Value + 8　　　　　　　　　　 'セルC1　　　　書込行の位置決定セルＧ１の数字に８を加算した数値が登録される行になります。 Sheets("DATA見積").Activate　　　　　　　　　　　　　　　　　　　　　 '作業シート　アクテイブに Range("B2:DE2").Select '登録データ範囲を指定 Selection.Copy Range("B" & 位置).Select　　　　　　　　　　　　　　　　　　　　　　　　 '値のみ貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A7").Select Application.CutCopyMode = False 全体のマクロは次のとおりです。

元々のマクロは黒文字で、それに追加した説明は青色とします。
マクロの中で、頭に　'　　がある行は注釈文字列になり、マクロの実行には影響しません。

Sub 書込見積新規()
'
'　データ転記まえに必要最低限の入力があるかどうかチェック
''
　　Range("G1").Select
　　ActiveCell.FormulaR1C1 = "=DATA見積!R[1]C[-6]+1"
　　Range("G2").Select

　　If MsgBox(prompt:="印刷はしましたか。登録したらデータは消えますよ。いいですか(^｡^)。", _
　　　　　Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then
　　　　　Exit Sub
　　End If

　ここのＩＦからＥｎｄ　ＩＦ　は最初の確認です。
　キャンセルすれば、以下の作業を実行しないでこのマクロは終了です。

　　Application.ScreenUpdating = False
　　
　画面の変化を表示をさせないようにします。

　　Dim message As String
　変数の宣言です
'チェック
　該当セルが空白ならば、作業は終了です。
　　　If Range("B3").Value = "" Then
　　　　　　message = MsgBox("お得意先名が入力されていません", vbYes, "入力確認")
　　　　　　Exit Sub
　　　End If

　　　If Range("G5").Value = "" Then
　　　　　　message = MsgBox("日付が入力されていません", vbYes, "入力確認")
　　　　　　Exit Sub
　　　End If

　　　If Range("C7").Value = "" Then
　　　　　　message = MsgBox("工事名が入力されていません", vbYes, "入力確認")
　　　　　　Exit Sub
　　　End If

　　　If Range("B14").Value = "" Then
　　　　　　message = MsgBox("摘要が入力されていません", vbYes, "入力確認")
　　　　　　Exit Sub
　　　End If

'すべて入力されていれば登録します。確認。

セル　B3　　　　　G5　　　　　C7　　　　　B14
　お客様名　　年月日　　工事名　　　摘要の一行目　　　

最低限　上記セルに　入力がなければ　　保存はしません。以下の作業はしません。

　　　If MsgBox(prompt:="データの書き込みです。いいですか(^｡^)。", _
　　　　　　　Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then
　　　　　　　Exit Sub
　　　End If

　ここのＩＦからＥｎｄ　ＩＦ　は2度目の確認です。
　キャンセルすれば、以下の作業を実行しないでこのマクロは終了です。

　2度の確認作業を通過したらデータの保存です。
'
'見積書の新規保存です　シート　DATA見積　の９行目以下に保存します。
'
　　　Application.ScreenUpdating = False
画面の変化を表示をさせないようにします。
　　　Sheets("DATA見積").Unprotect
シートの保護を解除する
　　　Dim 位置 As Integer
変数の宣言です
　　　位置 = Sheets("見積書").Cells(1, 7).Value + 8　　　　　　　　 'セルC1　　　　書込行の位置決定

　　　If MsgBox(prompt:="DATA見積への　" & 位置 - 8 & "　行目への保存です。メモをお勧めします。(^｡^)。", _
　　　　　　　Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then
　　　　　　　Exit Sub
　　　End If

　ここのＩＦからＥｎｄ　ＩＦ　は３度目のの確認です。
　キャンセルすれば、以下の作業を実行しないでこのマクロは終了です。

　くどいですが、２度ではなく3度目の確認作業を通過したらデータの保存です。

'　　 Application.ScreenUpdating = False

　　　Sheets("DATA見積").Activate　　　　　　　　　　　　　　　　　　　　　　　 '作業シート　アクテイブに
　　　Range("B2:DE2").Select　　　　　　　　　　　　　　　　　　　　　　　　　　　 '登録データ範囲を指定
　　　Selection.Copy
　　　Range("B" & 位置).Select　　　　　　　　　　　　　　　　　　　　　　　　　　'値のみ貼り付け
　　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:　　　　　　=False, Transpose:=False
　　　Range("A7").Select

データが下の行に貼付けられました。

　　　Application.CutCopyMode = False

　　　Sheets("DATA見積").Protect
シートの保護をする
　　　Application.ScreenUpdating = True

　　　MsgBox "転記終了"

　　　Sheets("見積書").Select

　　　クリア全部
サブマクロの実行になります
　　　Range("A2").Select

End Sub

'
　　　　　　　　　　　　　　　　　　　次は｛クリア全部｝の説明になります　　　　　　　　　　　　

見積書請求書作成V2.0