EXCELでSheetにデータを蓄積したい

質問

Sheet1に入力シートを作成し、Sheet2に蓄積シートを作成しました。
Sheet1で作成されたデータをSheet2に蓄積させておきたい。
Sheet1のA2の値が入力された場合に実行するとすると
Sheet1のデータ数は、毎回異なります。
他を参考に以下のように作ってみたのですが、
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastA As Long, lastB As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("入力シート")
Set ws2 = Sheets("蓄積シート")
With Target
If .Address <> "$A$2" Or .Count <> 1 Or IsEmpty(Target) Then Exit Sub
If WorksheetFunction.Count(ws1.Range("a1:s1")) <> 19 Then Exit Sub
lastA = ws2.Range("a65536").End(xlUp).Row
lastB = ws1.Range(("a2:s2"), Selection.End(xlDown)).Select
ws2.Range("a" & lastA + 1).Resize(1, 19).Value = _
ws1.Range("a2:S2").Resize(1, 19).Value
End With
End Sub
'ws1.Range("a2:S2").Resize(1, 19).Value　の部分で
'上記ws1の範囲の内、Row2の値しかws2へ反映されません
どなたか教えて頂けないでしょうか。

回答No.3

WWolf · ベストアンサー

＃1産の補足説明を拝見しました。
質問者さんのロジックに矛盾を感じるのですが多分下記で出来ると思います。
シート1にコントロールツールボックスのコマンドボタンを作成しそのボタンを押下すると下記のロジックを動かすようにして下さい。

Public La, Lb
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
La = ws2.Range("a65536").End(xlUp).Row
Lb = ws1.Range("a65536").End(xlUp).Row
For j = 1 To Lb
For i = 1 To 19
ws2.Cells(La + j, i).Value = ws1.Cells(j, i).Value
Next
Next
End Sub

補足

ご指導ありがとうございます。
早速試してみました。
(1)シート1の1行目に項目行を設けているので
Lb = ws1.Range("a65536").End(xlUp).Row
の部分を
Lb = ws1.Range("a2").End(xlDown).Row
と記述しましたが、どうしても1行目の項目行を含めた形でシート2へ蓄積されます。範囲の設定が間違っているのでしょうか？ご指導願います。
(2)またシート2へ蓄する最終行については
ws2.Cells(La + j, i).Value = ws1.Cells(j, i).Value
の部分を
ws2.Cells(La + 1 + j, i).Value = ws1.Cells(j, i).Value
と記述し、データのある最終行の1つ下を選択するようにしました。これで宜しいでしょうか？

回答No.7

WWolf

WWolfです
質問者さんのロジック等を見ていて１行ブランクを入れたいのだとおもっていました。
どうぞ、あたりはご自由にして頂いて結構ですよ。
もしこれで問題解決しているならば、この質問を締め切っていただければありがたいです。
これからも頑張ってください。

お礼

大変お世話になりました。
お陰で現在うまく稼動しております。
これからも勉強していきたいと思っております。

回答No.6

WWolf

(1)シート1の1行目に項目行を設けているので
Lb = ws1.Range("a65536").End(xlUp).Row
の部分をLb = ws1.Range("a2").End(xlDown).Row
と記述しましたが、どうしても1行目の項目行を含めた形でシート2へ蓄積されます。範囲の設定が間違っているのでしょうか？ご指導願います。

そこではなく

For j = 1 To Lb
を
For j = 2 To Lb
にして下さい。

(2)またシート2へ蓄する最終行については
ws2.Cells(La + j, i).Value = ws1.Cells(j, i).Value
の部分をws2.Cells(La + 1 + j, i).Value = ws1.Cells(j, i).Valueと記述し、データのある最終行の1つ下を選択するようにしました。これで宜しいでしょうか？

それでもいいですが、多分質問者さんのしたいことはある一度の転記ごとに一行あけたいのでは？
それなら
La = ws2.Range("a65536").End(xlUp).Row
を
La = ws2.Range("a65536").End(xlUp).Row+1
にしないと、常にＬａはシート2の最終行を探していますから一行あかないかも？試していなしから何とも言えませんが、質問者さんのロジックで思うようになっているのでしたらそれでも良いかと重いますよ。
頑張ってください。

補足

早速のご指導ありがとうございます。
For j = 1 To Lb
を
For j = 2 To Lb
にして試してみました。そうするとブランク行が1行生じるのですね。ブランク行は不要なので
ws2.Cells(La + 1 + j, i).Value = ws1.Cells(j, i).Valueと記述を、ws2.Cells(La - 1 + j, i).Value = ws1.Cells(j, i).Valueと記述したところうまくいきました。この方法でも宜しいでしょうか？

回答No.5

error123

No1＆４です。

>シート1の1行目に項目行を設けているので

それならこれはどういう意味？
If WorksheetFunction.Count(ws1.Range("a1:s1")) <> 19 Then Exit Sub
これって、１行目のAからSまでに全部数値が入ってなければ作動しないって意味でしょ？

まあいいや。
１行目を持っていかないなら、これでどう？
ご指定どおりA2セルに違う値が入力されたときしか作動しないけど。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastA As Long, lastB As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("入力シート")
Set ws2 = Sheets("蓄積シート")
With Target
If .Address <> "$A$2" Or .Count <> 1 Or IsEmpty(Target) Then Exit Sub
If WorksheetFunction.Count(ws1.Range("A1:S1")) <> 19 Then Exit Sub
lastA = ws2.Range("A65536").End(xlUp).Row
ws1.Range("A2", ActiveCell.SpecialCells(xlLastCell)).Copy
ws2.Range("A" & lastA + 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
End Sub

お礼

最初からIf WorksheetFunction.Count(ws1.Range("a1:s1")) <> 19 Then Exit Subの記述は間違っていました。
当初はＡ２の値が変化した場合に表を蓄積しようと考えていましたが、NO.3の「WWolf」さんのご指導の通り「CommandButton」を設けてデータの蓄積を行った方が間違いを生じにくいと思いました。
「error123」さんのご指導も、セル入力時の変更等についての今後の勉強に役立たせて頂きます。
今後とも宜しくご指導願います。

回答No.4

error123

No1です。

> シート1のA1からS56迄にデータが有ります。
> このすべてをシート2へ蓄積したいのです。

それならこんな感じかな？

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastA As Long, lastB As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("入力シート")
Set ws2 = Sheets("蓄積シート")
With Target
If .Address <> "$A$2" Or .Count <> 1 Or IsEmpty(Target) Then Exit Sub
If WorksheetFunction.Count(ws1.Range("a1:s1")) <> 19 Then Exit Sub
lastA = ws2.Range("a65536").End(xlUp).Row
ws1.Range(("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy
ws2.Range("a" & lastA + 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
End Sub

回答No.2

WWolf

やりたいことをもう少し詳しく・・・
例えば”入力シート”のデータはどのような（列？行？）で入力されるのか。
ただ多分質問者さんがしたいことはこれに近いかと・・・
（参考）
Public La
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
La = ws2.Range("a65536").End(xlUp).Row
With Target
If .Address <> "$A$2" Or .Count <> 1 Or IsEmpty(Target) Then Exit Sub
If WorksheetFunction.Count(ws1.Range("a1:s1")) <> 19 Then
MsgBox "Ａ列からＳ列の間に未入力セルがあります"
Else
For i = 1 To 19
ws2.Cells(La + 1, i).Value = ws1.Cells(1, i).Value
Next
End If
End With

End Sub

回答No.1

error123

だって、ws1.Range("a2:S2").Resize(1, 19).Valueじゃ、入力シートA1:S2、つまり全部2行目じゃない？

それからlastBがどこにも参照されて無いみたい。

入力シートA2に数値が入力され、A1:S1がフルに入力されている場合、そのシートのどこの部分を蓄積シートに持っていきたいの？

補足

シート1のA1からS56迄にデータが有ります。
このすべてをシート2へ蓄積したいのです。
また、次回シート1の入力データ数はA1からS70と言ったように変化します。
これをシート2へ前回のデータに続けて蓄積したいのです。
lastB = ws1.Range(("a2:s2"), Selection.End(xlDown)).Select
で指定した範囲のデータをシート2へ蓄積したいのですがいかがでしょうか。