VBAについて教えて下さい

質問

作業内容
(1)　「 初期入力 ! B列 」　ダブルクリック

VBAProject　⇒　「 初期入力 ! 」
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
ドロップダウン代わりに「Data ! 」を表示
Sheets("Data").Activate
End Sub

(2)　値をダブルクリックして、「初期入力」に戻る。

VBAProject　⇒　「 Data ! 」
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Range("FC63364").Activate
Sheets("初期入力").Activate
’選択した値を「初期入力!」シートに戻す
ActiveCell.Value = Target.Value
End Sub

ここまでが現在の作業です。

現在の工程内に下記を増やしたいのですが、エラーが出て増やせません。教えて頂けませんか＞

(3)　「Data ! FB63375,FG63375,FI63375」 を 「拾い出し ! K4」 にコピー＆ペーストしたいです。

「Data ! FB63375」⇒「拾い出し ! K4」へ
「Data ! FG63375」⇒「拾い出し ! L4」へ
「Data ! FI63375」⇒「拾い出し ! M4」へ

Range("FB63375,FG63375,FI63375").Select
Range("FI63375").Activate
Selection.Copy
Sheets("拾い出し").Select
Range("K4").Select
ActiveSheet.Paste
Sheets("Data").Select
End Sub

＊次回「Data!FB63375,FG63375,FI63375」をコピーすると、前回コピーされた下の行「拾い出し ! K5」にコピーするようにしたいです。

(4)　Data!FC63367:FI63374」を「拾い出し!O4」にコピー＆ペーストしたいです。

Range("FC63367:FI63374").Select
Selection.Copy
Sheets("拾い出し").Select
Range("O4").Select
ActiveSheet.Paste
Sheets("Data").Select
End Sub

＊次回「Data!FC63367:FI63374」をコピーすると前回コピーされた下の行「拾い出し!O11」にコピー＆ペーストしたいです。

お分かりになられる方おられましたら、教えて頂けませんか？
宜しくお願いします。

回答No.1

DOUGLAS_ · ベストアンサー

＞エラーが出て増やせません。
　どこでエラーが出るのか存じませんが．．．。

＞前回コピーされた下の行「拾い出し ! K5」にコピーするようにしたいです。
(3) の
Range("K4").Select
を
If Range("K4").Value = "" Then
　Range("K4").Select
Else
　Range("K" & Rows.Count).End(xlUp).Offset(1).Select
End If
に、

＞前回コピーされた下の行「拾い出し!O11」にコピー＆ペーストしたいです。
(4) の
Range("O4").Select
を
If Range("O4").Value = "" Then
　Range("O4").Select
Else
　Range("O" & Rows.Count).End(xlUp).Offset(1).Select
End If
に変更してみられたらどうなるでしょうか？

　ちなみに、
＞前回コピーされた下の行「拾い出し!O11」
ではなくて「拾い出し!O12」だと思われますが．．．。

お礼

DOUGLAS_さん、回答ありがとうございます。

エラーが出ずに出来るようになりました。

ありがとうございました。
今後共、よろしくお願いします。

補足

DOUGLAS_さんに教えて頂いたのを、早速実行させて頂きました。

（マクロの登録）
VBAProject　⇒　Module2

Sub Macro1()
Range("FB63375,FG63375,FI63375").Select
Range("FI63375").Activate
Selection.Copy
Sheets("拾い出し").Select

If Range("K4").Value = "" Then
Range("K4").Select
Else
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
End If
ActiveSheet.Paste
Sheets("Data").Select

（結果）
一回目は、「K4」、「L4」、「M4」に値が入りました。
２回目は、「K93」、「L93」、「M93」に入りました。　

（希望）
２回目は、「K5」、「L5」、「M5」に入るようにしたいです。
「K2:M93」に罫線が引いてあります。それでですかね～？

（マクロの登録）
VBAProject　⇒　Module2

Sub Macro2()

'「Data!FC63367:FI63374」を「拾い出し!O4」にコピー＆ペースト

Range("FC63367:FI63374").Select
Selection.Copy
Sheets("拾い出し").Select
If Range("O4").Value = "" Then
Range("O4").Select
Else
Range("O" & Rows.Count).End(xlUp).Offset(1).Select
End If

ActiveSheet.Paste
Sheets("Data").Select
End Sub

（結果）
一回目は、「O4:U11」に値が入りました。
２回目も、「O4:U11」に入りました。　

（希望）
２回目は、「O12:U19」に入るようにしたいです。

すみませんが教えて頂けませんか？
よろしくお願いします。

回答No.2

DOUGLAS_

＞Sub Macro1()
＞２回目は、「K93」、「L93」、「M93」に入りました。　
＞「K2:M93」に罫線が引いてあります。それでですかね～？
　罫線は関係ありません。
　１回目が終わった後で「K4」を アクティブ にして、[Ctrl] + [↓]（下矢印）を押下してみてください。
　私の意図通りでしたら、アクティブセル は「K65536」になるはずです。
　もし、途中の セル で カーソル が止まるようでしたら、見た目何も入っていないようでも スペース などが入っています。
　[回答番号：No.1] の コードは、「K5:K65536」に何も入っていないことが前提の コード ですので、不要な スペース 等が入っている場合には、初期設定として、「K4:K65536」の範囲は クリア（範囲選択後 [Delete]）しておいてください。

＞Sub Macro2()
＞２回目も、「O4:U11」に入りました。　
　想像ですが、一回目に、「O4:U11」に値が入ったときに「O4」セルが ブランク になっている、というようなことはありませんか？
　そういう場合もあるのでしたら、コード を書き換えなければなりません。
　この点につきましては、「Sub Macro1()」も同様です。

お礼

DOUGLAS_さん、回答ありがとうございます。

うまく出来ました～！
DOUGLAS_さんのおっしゃる通りです。

Sub Macro1()はK5以降に数式が入っていた為、駄目だったようですね～

Sub Macro2()の方も、うまく出来ました。

今回の事で、色々勉強になりました。

DOUGLAS_さん、何度もお答え頂きありがとうございました。
今後共、よろしくお願いします。