[[20150327235722]]　『自動転記すると最終行に2行記入されてしまう』（mico）　ページの最後に飛ぶ

『自動転記すると最終行に2行記入されてしまう』（mico）

エクセルで見積書を作成するため、奮闘中の初心者です。
ネットで調べながら進めているのですが、どうしてもできない
部分があるので、お力拝借できれば幸いです。

sheet1　見積書
sheet2　納品書
sheet3　請求書
sheet4　一覧表

sheet1の見積書に入力するとsheet2、sheet3には自動で入力されるように
元々の書式がなっていました。各シートとも必要なセル以外は保護がかかっています。

それに加えて
・保存ボタンを押すとsheet1（見積書）の一部内容を、sheet4（一覧表）に
　自動転記されるようにしたい
・A転記後、Sheet1(見積書)の内容をクリアにしたい
・上記と同時に自動で管理番号を連番で振りたい

転記と自動連番はされるのですが、一覧表には同じ情報が２行ずつ追加されてしまいます。

転記元（見積書）
G1管理番号　G3日付　A4顧客名　A5内容　A6金額
A15～A48は見積内容を記入します（空白セルあり）
転記先（一覧表）
それぞれA～E列に転記していきます。

以下、VBAに記載した内容です。
これだと一覧表に２行づつ記入されてしまいます。
正しい指示の書き方が分かりません。
どなたか教えていただけると幸いです。

Private Sub 保存_Click()

ActiveSheet.Unprotect Password:="****"

Dim wst1 As Worksheet
Dim wst4 As Worksheet
Set wst1 = ThisWorkbook.Worksheets("見積書")
Set wst4 = ThisWorkbook.Worksheets("一覧表")

For i = 15 To 48

If wst1.Range("A" & i) <> "" And Not IsNull(wst1.Range("A" & i)) Then

myRow = wst4.Cells(Rows.Count, "A").End(xlUp).Row + 1

wst4.Range("A" & myRow) = wst1.Range("G1")
wst4.Range("B" & myRow) = wst1.Range("G3")
wst4.Range("C" & myRow) = wst1.Range("A4")
wst4.Range("D" & myRow) = wst1.Range("A5")
wst4.Range("E" & myRow) = wst1.Range("C12")

End If

Next i

wst1.Range("G1") = wst1.Range("G1") + 1

wst1.Range("A4").ClearContents
wst1.Range("A5").ClearContents
wst1.Range("A15:A42").ClearContents
wst1.Range("A44:A48").ClearContents
wst1.Range("E15:E42").ClearContents
wst1.Range("F15:F42").ClearContents

ActiveSheet.Protect Password:="****"

End Sub

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

 A15～A48 は何が入っているのですか？
 まったくもって推測ですけれど、これでは問題あるでしょうか。

 Private Sub 保存_Click()
    Dim wst1 As Worksheet
    Dim wst4 As Worksheet
    Set wst1 = ThisWorkbook.Worksheets("見積書")
    Set wst4 = ThisWorkbook.Worksheets("一覧表")

    If WorksheetFunction.CountBlank(wst1.Range("A15:A48")) = 34 Then Exit Sub

    wst4.Unprotect Password:="****"

    myRow = wst4.Cells(Rows.Count, "A").End(xlUp).Row + 1
    wst4.Range("A" & myRow) = wst1.Range("G1")
    wst4.Range("B" & myRow) = wst1.Range("G3")
    wst4.Range("C" & myRow) = wst1.Range("A4")
    wst4.Range("D" & myRow) = wst1.Range("A5")
    wst4.Range("E" & myRow) = wst1.Range("C12")

    wst1.Range("G1") = wst1.Range("G1") + 1
    wst1.Range("A4:A5,A15:A42,A44:A48,E15:F42").ClearContents

    wst4.Protect Password:="****"
 End Sub

（Mook） 2015/03/28(土) 01:15

ご回答ありがとうございます。
ド素人なもので、まったく分からずでしたが、
仕事でやらねばならず...。

望んでいた通りに動きました!!!!!!

A15～A18は、見積明細項目や備考にあたる部分なので、一覧表には
反映させていませんでした。

大変助かりました。ありがとうございます。
（mico） 2015/03/28(土) 09:30

コメント返信：

[ 一覧(最新更新順) ]

[[20150327235722]] 『自動転記すると最終行に2行記入されてしまう』（mico） ページの最後に飛ぶ

[[20150327235722]]　『自動転記すると最終行に2行記入されてしまう』（mico）　ページの最後に飛ぶ