プロが教えるわが家の防犯対策術!

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へ反映されません
どなたか教えて頂けないでしょうか。

A 回答 (7件)

#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つ下を選択するようにしました。これで宜しいでしょうか?

補足日時:2004/12/17 13:14
    • good
    • 1

WWolfです


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

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

お礼日時:2004/12/27 17:39

(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
にしないと、常にLaはシート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と記述したところうまくいきました。この方法でも宜しいでしょうか?

補足日時:2004/12/20 09:37
    • good
    • 0

No1&4です。



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

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

まあいいや。
1行目を持っていかないなら、これでどう?
ご指定どおり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
    • good
    • 0
この回答へのお礼

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

お礼日時:2004/12/20 09:53

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
    • good
    • 0

やりたいことをもう少し詳しく・・・


例えば”入力シート”のデータはどのような(列?行?)で入力されるのか。
ただ多分質問者さんがしたいことはこれに近いかと・・・
(参考)
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 "A列からS列の間に未入力セルがあります"
Else
For i = 1 To 19
ws2.Cells(La + 1, i).Value = ws1.Cells(1, i).Value
Next
End If
End With

End Sub
    • good
    • 0

だって、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へ蓄積したいのですがいかがでしょうか。

補足日時:2004/12/16 17:16
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!