エクセルマクロの件

質問

AとBにあるデータの一覧をCにコピーして、全体を日付順にソートするという処理をしたいと思っています。

そこでエクセルマクロにて
（１） Ａのデータの必要部分をコピー、Ｃに貼り付け
（２） Ｂのデータの必要部分をコピー、Ｃに貼り付け
（３） 全体を日付順にソート
というものができました。

ただ、Ｂのデータを貼り付ける位置で問題が発生しています。
仮に、Ａに200行までのデータが入っている場合、Ｂのデータを201行目に張り付けすれば問題ありませんが、Ａのデータが増えたときにはＡのデータの201行目以降はＢのデータで上書きされてしまいます。
そこで、Ｂのデータを上記の例だと250行目あたりに張り付けするようにマクロを変えると、なぜかＢのデータは一切Ｃに反映されなくなってしまいます。

この理由と、上記の対策があれば教えていただければと思います。
ちなみに、現在設定されているマクロは以下の通りです。
自動記録にてつくってあるので無駄な部分もあるかと思いますが、よろしければご覧いただければと思います。

Sheets("Ａのシート").Select
ActiveWindow.SmallScroll Down:=-138　
Range("A4:O200").Select
Selection.Copy
Sheets("Ｃのシート").Select
ActiveWindow.SmallScroll Down:=-162　
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False　
Sheets("Ｂのシート").Select
Range("G25:G28").Select
Range("G28").Activate
ActiveWindow.SmallScroll Down:=-30
Range("A4:O120").Select
Selection.Copy
Sheets("Ｃのシート").Select
ActiveWindow.SmallScroll Down:=147
Range("A181").Select
ActiveSheet.Paste
Cells.Select
Range("A4:O200").Select
Selection.Sort Key1:=Range("C4"), Order1:=xlAscending, Key2:=Range("D4") _
, Order2:=xlAscending, Key3:=Range("E4"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal
End Sub

回答No.4

imogasi · ベストアンサー

シートA,Bデータ全行をシートCに移すのかなと思いますが
＞Ａのデータの必要部分を
と「必要部分」を質問文章に入れられると、下記のようなコードとなるのかなと思う。
回答しよう思う者は文章についてナーバスにならざるを得ないので、明確に表現してほしい。
参考までに
Sub test01()
Dim r1 As Range
Dim r2 As Range
Worksheets("Sheet1").Activate
Set r1 = Application.InputBox("Aシート範囲", Type:=8)
Worksheets("Sheet2").Activate
Set r2 = Application.InputBox("Bシート範囲", Type:=8)
r1.Copy Worksheets("Sheet3").Range("A1")
d = Worksheets("Sheet3").Range("A65536").End(xlUp).Row
r2.Copy Worksheets("Sheet3").Range("A" & d + 1)
Set r1 = Nothing
Set r2 = Nothing
End Sub
ーーー
マクロの記録の影響でSelectが頻繁に出てくるコードは冗長です。
改善したらどうでしょう。
ーー
全行をシートCに移す場合
Sub test02()
Dim d1 As Range
Dim d2 As Range
Worksheets("Sheet1").Activate
Set d1 = Worksheets("Sheet1").Range("A2").CurrentRegion
d1.Copy Worksheets("Sheet3").Range("A2")
Worksheets("Sheet2").Activate
Set d2 = Worksheets("Sheet2").Range("A2").CurrentRegion
d = Worksheets("Sheet3").Range("A65536").End(xlUp).Row
d2.Copy Worksheets("Sheet3").Range("A" & d + 1)
Set d1 = Nothing
Set d2 = Nothing
End Sub

お礼

ありがとうございます。
無駄な部分が多々あると思うので回答を参考にしながら改善できればと思います^^

回答No.3

zap35

シートのデータ最終行を取得するにはEndプロパティを使います。A列の最終行は
　Range("A65536").End(xlUp)
です。また最終行の１つ下のセルは
　Range("A65536").End(xlUp).Offset(1, 0)
になります。（２回目の貼り付けを行うセルになります）

Sub Macro2()
Dim ptr As Integer
　Sheets("Sheet1").Activate
　ptr = Range("A65536").End(xlUp).Row
　Range("A4:O" & ptr).Copy Destination:=Sheets("Sheet3").Range("A4")

　Sheets("Sheet2").Activate
　ptr = Sheets("Sheet2").Range("A65536").End(xlUp).Row
　Range("A4:O" & ptr).Copy Destination:=Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)

　Sheets("Sheet3").Activate
　Range(Cells(4, "A"), Cells(Range("A65536").End(xlUp).Row, "O")).Sort _
　　Key1:=Range("C4"), Order1:=xlAscending, Key2:=Range("D4"), _
　　Order2:=xlAscending, Key3:=Range("E4"), Order3:=xlAscending, _
　　Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
　　Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, _
　　DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
End Sub

お礼

ありがとうございます。
endがというものが使えるんですね。
回答を参考にやってみたいと思います

回答No.2

hana-hana3

Ａ列基準で良いなら下記でいかがでしょうか？
データ範囲も貼付け位置も自動的に設定されるので、データ量が変化しても問題なく動作するかと思います。

Sheets("Ａのシート").Select
Range(Range("A4:O4"), Range("A4").End(xlDown)).Copy
Sheets("Ｃのシート").Select
Range("A4").Paste

Sheets("Ｂのシート").Select
Range(Range("A4:O4"), Range("A4").End(xlDown)).Copy
Sheets("Ｃのシート").Select
Range("A65536").End(xlUp).Offset(1).Paste

Range(Range("A4:O4"), Range("A4").End(xlDown)).Select
Selection.Sort Key1:=Range("C4"), Order1:=xlAscending, Key2:=Range("D4") _
, Order2:=xlAscending, Key3:=Range("E4"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal

お礼

ありがとうございます。
回答を参考にしてやってみたいと思います＾＾

回答No.1

chem_taro

'Aのシートのコピー
Sheets("Ａのシート").Select
Range("A4:O200").Select 'Aのシートのコピーする場所
Selection.Copy
'Cのシートへ貼り付け
Sheets("Ｃのシート").Select
Range("A4").Select 'Cのシートの貼り付ける場所
ActiveSheet.Paste

'Bのシートのコピー
Sheets("Ｂのシート").Select
Range("A4:O120").Select 'Bのシートのコピーする場所
Selection.Copy
'Cのシートへ貼り付け
Sheets("Ｃのシート").Select
Range("A250").Select 'Cのシートの貼り付ける場所
ActiveSheet.Paste

'並べ替え
Range("A4:O370").Select '並べ替えする範囲
Selection.Sort Key1:=Range("C4"), Order1:=xlAscending, Key2:=Range("D4") _
, Order2:=xlAscending, Key3:=Range("E4"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal

こんな感じ？

お礼

ありがとうございます。
回答を参考にして確認させていただきます^^