【マクロ】対象データを別シートの最終行の下へ貼り付けをしたい。

今回の質問に似た質問を以前もさせていただいておりますが
マクロ初心者なもので、どこをどのように修正したらよいかわからず再度投稿させていただいております。

※以前投稿した質問です。特定列を別シートへコピペしたい。
↓
https://oshiete.goo.ne.jp/qa/9605241.html


自分なりに、上記マクロを作成して試しに実行してみてなんとかうまく機能したのですが
仮としてそれぞれの2行目にコピペするようにとしか書けず、それを空白行からコピペするといった
式にしたいのです。↓
--------------------------------------------------------------------------------------------------------------------
Sub Sample3()

Worksheets("29.1月実績").Range("G2:Q1000").Copy Worksheets("元データ(201607~)").Range("A2")
Worksheets("29.1月実績").Range("T2:T1000").Copy Worksheets("元データ(201607~)").Range("M2")
Worksheets("29.1月実績").Range("V2:V1000").Copy Worksheets("元データ(201607~)").Range("O2")
Worksheets("29.1月実績").Range("H2:J1000").Copy Worksheets("リスト").Range("A2")
Worksheets("29.1月実績").Range("L2:P1000").Copy Worksheets("リスト").Range("D2")

End Sub
-------------------------------------------------------------------------------------------------------------------
①元データ(コピー元)シート名：「29.1月実績」
②貼り付け先シート名①：「元データ(201607~)」
③貼り付け先シート名②：「リスト」

★したいこと★
①の元データシートのG列からQ列の入力されているすべてのデータを②の「元データ(201607~)」シートA列の入力されている最終行の下からコピペしたい。
②の元データシートのT列の入力されているすべてのデータを②の「元データ(201607~)」シートM列の入力されている最終行の下からコピペしたい。
③の元データシートのV列の入力されているすべてのデータを②の「元データ(201607~)」シートO列の入力されている最終行の下からコピペしたい。
④の元データシートのH列からJ列の入力されているすべてのデータを②の「リスト」シートA列の入力されている最終行の下からコピペしたい。
⑤の元データシートのL列からP列の入力されているすべてのデータを②の「リスト」シートD列の入力されている最終行の下からコピペしたい。

画像も添付いたしますが、説明不足な点あるかと存じますので、質問頂ければ幸いです。
何卒、ご教授願います。

質問者からの補足コメント

• ①元データ(コピー元)シート名：「29.1月実績」

  
    補足日時：2017/02/22 15:21

• ②貼り付け先シート名①：「元データ(201607~)」

  
    補足日時：2017/02/22 15:22

• ③貼り付け先シート名②：「リスト」

  
    補足日時：2017/02/22 15:23

No.5 ベストアンサー 回答者： tatsu99 回答日時： 2017/02/23 14:28

No3です。

>さっそく実行してみたのですが、コピー先に書き込まれませんでした。。
>また、私の説明が不足＆わかりづらく、ちゃんとお伝えできていない可能性が大きい気がしたので
>再度下記に書かせていただきます。

全くなにも、コピーされないのでしょうか？
念のため、以下のマクロを実行していただけますか。
内容は特に変わっていません。
MsgBox ("maxrow1=" & maxrow1 & " maxrow2=" & maxrow2 & " maxrow3=" & maxrow3) '①追加
を追加しただけです。
--------------------------------------
Option Explicit
Public Sub Sample3()
Const sh1 As String = "29.1月実績" 'コピー元シート
Const sh2 As String = "元データ(201607~)" 'コピー元シート
Const sh3 As String = "リスト" 'コピー元シート
Dim maxrow1 As Long 'コピー元最大行
Dim maxrow2 As Long 'コピー先最大行
Dim maxrow3 As Long 'コピー先最大行
Dim rg1 As String
Dim rg2 As String
Dim rg3 As String
maxrow1 = Worksheets(sh1).Cells(Rows.Count, "G").End(xlUp).Row 'コピー元のG列最大行取得
maxrow2 = Worksheets(sh2).Cells(Rows.Count, "A").End(xlUp).Row 'コピー先のA列最大行取得
maxrow3 = Worksheets(sh3).Cells(Rows.Count, "A").End(xlUp).Row 'コピー先のA列最大行取得
MsgBox ("maxrow1=" & maxrow1 & " maxrow2=" & maxrow2 & " maxrow3=" & maxrow3) '①追加
rg1 = "G2:Q" & maxrow1
rg2 = "A" & (maxrow2 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh2).Range(rg2)
rg1 = "T2:T" & maxrow1
rg2 = "M" & (maxrow2 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh2).Range(rg2)
rg1 = "V2:V" & maxrow1
rg2 = "O" & (maxrow2 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh2).Range(rg2)
rg1 = "H2:J" & maxrow1
rg3 = "A" & (maxrow3 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh3).Range(rg3)
rg1 = "L2:P" & maxrow1
rg3 = "D" & (maxrow3 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh3).Range(rg3)
End Sub
----------------------------------------------------
上記を実行した場合に
maxrow1：29.1月実績の最終行・・・・１０００のはず
maxrow2：元データ(201607~)の最終行・・・・この次の行へコピーされるはず
maxrow3：リストの最終行・・・・この次の行へコピーされるはず
上記のmaxrow1,maxrow2,maxrow3,は期待通りの値が表示されていますでしょうか？

この回答へのお礼

お忙しい中、早速再度のご教授ありがとうございます。
新しくご教授頂いたマクロで無事、解決いたしました。
本当にいつも助かっております。感謝いたします。

お礼日時：2017/02/23 15:05

No.4 回答者： WindFaller 回答日時： 2017/02/23 12:47

#2の回答者です。

私が書いたことは、まず、全体のコードを見やすくするところから始まるものだと考えたのです。

>ご教授頂いたマクロで実行してみたのですがうまく転記されませんでした。
それは、とどのつまり、私のコードの読み違えが発生しているということです。私の書いたコードをいくら説明しても、解決には至らないと思います。

私が示したいことは、長いコードも、変数で登録してみじかくし、そこから、コードでどこが問題かを調べていく、ということだけです。
それは、プロの人でも、やっていることです。

そこで、私は、なるべく、もとのコードに近いスタイルで、加工してみました。

こちらが、ピッタリ合うものを作り上げるというのは、条件が全てわかっていないと無理だと思っています。

>　Set sh_291 = Worksheets("29.1月実績")
シート名は短い変数にまとめてしまう。
>　　iRw = .Cells(Rows.Count, "G").End(xlUp).Row
これはもとのデータの最後尾までを探しているのです。
(なお、私は、日本語の2バイト文字は変数に使いませんので、わかりにくいのかもしれません）Rw は、Row =行　の意味です。i, j, k と接頭辞をつけて、
iRw, jRw, kRw としました。

　　.Range("G2:Q" & iRw).Copy
ごらんになってわかるように、G2:Q◯　◯の中には数字が入ります。
この範囲をコピーするという意味です。

だから、
　　iRw = .Cells(Rows.Count, "G").End(xlUp).Row

G列の最後の行から[↑(アップキー）]で、データのあるところまでを探せという意味です。この意味の解釈が違えば、ぜんぜんコピーなどなされません。

さて、これ以上の説明をしても、実際のコードで試してみるしかありません。
それを、「デバッギング」といい、
ローカルウィンドウを、画面の下において、[F8](ファンクションキー）で、1つずつ進みながら、変数は、何を確保しているのか、とか見ながら進めていくものなのです。

ピッタリとご要望にあったコードが他の回答者さんから出れば、それはそれで良いと思いますが、デバッグの方法を知らないといつまでも同じ繰り返しになってしまうと思っています。あまり、そのようなお気持ちがないのでしたら、どうぞスルーして構いません。

添付画像は、デバッグの様子をみたものです。画面下にあるのは、ローカルウィンドウです。

この回答へのお礼

無知な私にご丁寧にご教授いただきありがとうございます。
「デバッギング」は教えていただいたようにやってみたのですが
まだ知識不足な私にはコードの簡素化含め、まだまだ勉強しなければわからない領域なので
今回、ご教授頂いた内容を今後参考にさせていただければと思います。
また、何かありましたらご教授頂ければ幸いです。

お礼日時：2017/02/23 15:08

No.3 回答者： tatsu99 回答日時： 2017/02/23 12:08

以下のマクロを標準モジュールへ登録し実行してください。

このマクロは、２回実行すると、2回目は、同じデータがコピー先に追加されますのでご注意ください。
（コピー先は上書きにはなりません）
-----------------------------------------------
Option Explicit
Public Sub Sample3()
Const sh1 As String = "29.1月実績" 'コピー元シート
Const sh2 As String = "元データ(201607~)" 'コピー元シート
Const sh3 As String = "リスト" 'コピー元シート
Dim maxrow1 As Long 'コピー元最大行
Dim maxrow2 As Long 'コピー先最大行
Dim maxrow3 As Long 'コピー先最大行
Dim rg1 As String
Dim rg2 As String
Dim rg3 As String
maxrow1 = Worksheets(sh1).Cells(Rows.Count, "G").End(xlUp).Row 'コピー元のG列最大行取得
maxrow2 = Worksheets(sh2).Cells(Rows.Count, "A").End(xlUp).Row 'コピー先のA列最大行取得
maxrow3 = Worksheets(sh3).Cells(Rows.Count, "A").End(xlUp).Row 'コピー先のA列最大行取得
rg1 = "G2:Q" & maxrow1
rg2 = "A" & (maxrow2 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh2).Range(rg2)
rg1 = "T2:T" & maxrow1
rg2 = "M" & (maxrow2 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh2).Range(rg2)
rg1 = "V2:V" & maxrow1
rg2 = "O" & (maxrow2 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh2).Range(rg2)
rg1 = "H2:J" & maxrow1
rg3 = "A" & (maxrow3 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh3).Range(rg3)
rg1 = "L2:P" & maxrow1
rg3 = "D" & (maxrow3 + 1)
Worksheets(sh1).Range(rg1).Copy Worksheets(sh3).Range(rg3)
End Sub
----------------------------------------------------------------

この回答へのお礼

いつもご教授頂き、感謝しております。
ありがとうございます。

さっそく実行してみたのですが、コピー先に書き込まれませんでした。。
また、私の説明が不足＆わかりづらく、ちゃんとお伝えできていない可能性が大きい気がしたので
再度下記に書かせていただきます。

【補足】
①コピー元："29.1月実績"シートのデータは1月分しか入っておらずA2：W1000までデータがあります。
②コピー先①："元データ(201607~)"は1月以前のデータが入っている為、以前のデータが入っている最終行の下から貼り付けたい。
③コピー先②："リスト"シートもコピー先①同様、1月以前のデータが入っている為、以前のデータが入っている最終行の下から貼り付けたい。


★したいこと★→①④⑤の文章を修正しました。
①の元データシートのG列からQ列の入力されているすべてのデータを②の「元データ(201607~)」シートA列からK列の入力されている最終行の下からコピペしたい。
②の元データシートのT列の入力されているすべてのデータを②の「元データ(201607~)」シートM列の入力されている最終行の下からコピペしたい。
③の元データシートのV列の入力されているすべてのデータを②の「元データ(201607~)」シートO列の入力されている最終行の下からコピペしたい。
④の元データシートのH列からJ列の入力されているすべてのデータを②の「リスト」シートA列からC列の入力されている最終行の下からコピペしたい。
⑤の元データシートのL列からP列の入力されているすべてのデータを②の「リスト」シートD列からH列の入力されている最終行の下からコピペしたい。

度々申し訳ありませんが、再度ご教授願います。

お礼日時：2017/02/23 14:00

No.2 回答者： WindFaller 回答日時： 2017/02/22 16:53

文書の一例を取り上げると

①の元データシートのG列からQ列の入力されている[すべてのデータ]を
②の「元データ(201607～)」シートA列の入力されている最終行の下へ、
コピペしたい。

最初に、引っかかるのは「すべてのデータ」という言葉です。
Worksheets("29.1月実績").Range("G2:Q1000").Copy
これがすべてのデータというのは、そのデータの最後までということだと思います。

マクロのコードが読めるようでしたら、私はこう解釈しました。

'//
Sub Sample3r()
　Dim sh_291 As Worksheet
　Dim shM As Worksheet
　Dim shL As Worksheet
　Dim iRw As Long '最後の行
　Dim jRw As Long 'コピー＆ペースト先の最後の行
　Dim kRw As Long
　
　Set sh_291 = Worksheets("29.1月実績")
　Set shM = Worksheets("元データ(201607～)")
　jRw = shM.Cells(Rows.Count, "A").End(xlUp).Row + 1
　
　Set shL = Worksheets("リスト")
　kRw = shL.Cells(Rows.Count, "A").End(xlUp).Row + 1
　
　With sh_291
　　iRw = .Cells(Rows.Count, "G").End(xlUp).Row
　　.Range("G2:Q" & iRw).Copy shM.Range("A" & jRw)
　　.Range("T2:T" & iRw).Copy shM.Range("M" & jRw)
　　.Range("V2:V" & iRw).Copy shM.Range("O" & jRw)
　　.Range("H2:J" & iRw).Copy shL.Range("A" & kRw)
　　.Range("L2:P" & iRw).Copy shL.Range("D" & kRw)
　End With
End Sub

なお、シートを変数に登録すれば見やすくなるはずです。

この回答へのお礼

ご教授いただきありがとうございます。

申し訳ありません、なんとなくしかコードが読めず。。。
お手数をおかけいたしますが、簡単にご説明いただいてもよろしいでしょうか？
また、ご教授頂いたマクロで実行してみたのですがうまく転記されませんでした。
原因は何が考えられますでしょうか？
度々恐縮ではございますが、何卒ご教授願います。

お礼日時：2017/02/23 10:32

No.1 回答者： yokomaya 回答日時： 2017/02/22 15:57

Range("A2")を

Range("A2").Offset(20000,0).End(xlUp).Offset(1,0)でどうでしょう？
他も同じ。

この回答へのお礼

早速ご教授いただきましてありがとございます。
ただ、ご教授頂いたモジュールで試してみたのですが
何も貼り付けないようになってしまいました。
原因は何が考えられますでしょうか？

お礼日時：2017/02/22 16:36