任意の複数行をコピーするマクロ

ＶＢを勉強中の初心者です。
マクロの自動記録でシート１の５～６行目をシート２のセルＡ３へコピーすることはできました。マクロの内容は
　　Sheets("Sheet1").Select
　　Rows("5:6").Select
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("A3").Select
　　ActiveSheet.Paste
となっていました。
上記のシート１の５～６行目を任意の複数行（例えば
A1 に 200306 A2 に 200307 A3 に 200307
A4 に 200307 A5 に 200308 A6 に 200309
A7 に 200309 のデータがあった場合、コピーしたい年月が 200307 の場合は A2 ～ A4 をシート２のＡ３へ）でコピーしたいのですが、どうすればよいのかどなたか教えて下さい。よろしくお願いします。

No.1 回答者： noname#8617 回答日時： 2004/06/22 15:47

Sheet1にこんなデータがあったとします。

A列が200のものだけをSheet2にコピーしたいとします。
※1行目にはタイトルが入っていること
※データ（B列）はすべて埋まっていること

| A | B | C |
--+-----+-----+-----+-
1| Key | Data| |
2| 100 | 10 | |
3| 200 | 20 | |
4| 200 | 5 | |
5| 300 | 25 | |
6| 300 | 10 | |
7| | | |

*****
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="200"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select

3行目の200の値を変えてあげれば
任意のものがコピーできます。

何をやっているかといいますと
オートフィルタをかけて対象のものだけをコピーする
という動作を記録しただけです。

※普通はループでまわして検索文字と一致するものを
　コピーすることでしょう。
※今回はあえてわかりやすい即席なやり方でした。

ループや変数を使用できるのであれば
そちらのやり方を回答しますがいかがでしょうか。

参考になったでしょうか。。。ふあん。

この回答への補足

Neninp:
Nendo = InputBox( _
Title:="年月入力", _
Prompt:="年月(例:200306)を入力して下さい。")
Nentuki = Nendo * 1
Sheets("ドキュメント1").Select
Gyou = 1
Check:
If Gyou = 65500 Then
GoTo Endlabel
End If
If Range("A" & Gyou) <> Nentuki Then
Gyou = Gyou + 1
GoTo Check
End If

Sheets("1").Select
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal
Gyou = 1
Search:
If Range("A" & Gyou) <> Nentuki Then
Gyou = Gyou + 1
GoTo Search
End If
Dim Myrule, Abc, Bcd
Abc = Gyou
Bcd = Abc + 1
Myrule:
If Range("A" & Abc) = Range("A" & Bcd) Then
Abc = Abc + 1
Bcd = Bcd + 1
GoTo Myrule
Else
Rows("1:" & Abc).Select ←←←←
End If
Selection.Copy
Sheets.Add.Name = 123
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("123").Move after:=Sheets("1")
Tuki = Nentuki Mod 100 & "月"
Sheets("123").Name = Tuki
Endlabel:
Range("A1").Select
End Sub


上記のマクロのなかの Rows("1:" & Abc).Select
"1:" を Gyou にしたいのですが実行するとエラーになります。よろしくお願いします。

補足日時：2004/06/22 16:21

No.2 回答者： noname#8617 回答日時： 2004/06/22 16:37

補足です。

。。
※は行った動作です。

Cells.Select
※シート全体を選択
Selection.AutoFilter
※メニューから[データ]-[フィルタ]-[オートフィルタ]
Selection.AutoFilter Field:=1, Criteria1:="200"
※A列を[200]でフィルタリング
Range("A1").Select
※A1セルを選択
Range(Selection, Selection.End(xlDown)).Select
※A1セルで[Shift]+[Ctrl]+[↓]を押下
Range(Selection, Selection.End(xlToRight)).Select
※A1セルで[Shift]+[Ctrl]+[→]を押下
Selection.SpecialCells(xlCellTypeVisible).Select
※[Alt]+[;]を押下 （可視セルのみ選択）
Selection.Copy
※コピー
Sheets("Sheet2").Select
※Sheet2を選択
Range("A1").Select
※Sheet2のA1セルを選択
ActiveSheet.Paste
※ペースト
Sheets("Sheet1").Select
※Sheet1を選択
Application.CutCopyMode = False
※コピー解除
Selection.AutoFilter
※メニューから[データ]-[フィルタ]-[オートフィルタ]
Range("A1").Select
※A1を選択

No.3 ベストアンサー 回答者： noname#8617 回答日時： 2004/06/22 16:42

>Rows("1:" & Abc).Select

Rows(Gyou & ":" & Abc).Select
ではいかがでしょうか。

この回答へのお礼

回答通りに実行しましたらＯＫでした。
たいへん有難うございました。

お礼日時：2004/06/29 11:27