エクセルで表の抽出

質問

Windows2000でExcel2000を使っています。
一応VBを使っています。
そこで、
荷主マスターみたいな表があります。
A列にふりがな、B列に漢字、C列に４月の売上個数・・・O列に３月の売上個数が入っています。
表は、あいうえお順でソートされているのですが、
そのうちの、ア行の１月分だけ抽出し別の場所に貼り付けたいのですがうまくいきません。（当然その後に、カ行の１月分・・・ン行の１月分と作業をする。）

　　Ａ　　　　Ｂ　　　Ｃ　・・・・　　Ｍ　　Ｎ　　Ｏ
ふりがな　漢字　４月　・・・・１月　２月　３月

　あ　　　　亜　　　２　　　　　　３　　５　　３
　い　　　　井　　　４　　　　　　２　　　　　２
　う　　　　卯　　　１　　　　 　　　　　２
　か　　　　化　　　　　　　　　　１　　２　　４
　さ　　　　差　　　３　　 　　　　５　　６　　２

こんな感じの表です。

つまり今月は、Ａ列のア行　Ｂ列のア行　Ｍ列のア行を抽出する。
来月は、ＡとＢは同じで２月Ｎ列を抽出する。

マクロを使い自動化したいので、VBに詳しい方教えてください。
分かりづらい質問で申し訳ありませんが、よろしくお願いします。

回答No.1

papayuka

あんまりスマートじゃないけど、こんな感じですか？
試すならテスト環境で。

4月～3月のセルには、日付型を書式設定した「x月」ではなく、テキストの「x月」が入っているとします。

Sub Test()
Dim ws As Worksheet, tws As Worksheet
Dim stRow As Long, edRow As Long, fR, fMonth
fMonth = Application.InputBox("対象月を指定して下さい。", _
　　　　　　　　　　"対象月", Format(Date, "m月"), Type:=2)
If fMonth = False Then Exit Sub
Set tws = ActiveSheet
With tws
　Set fR = .Cells.Find(fMonth, .Range("A1"), lookat:=xlWhole)
　If fR Is Nothing Then Exit Sub
　stRow = 2: edRow = 2
　Do While .Cells(stRow, 1).Value <> ""
　　Do While .Cells(stRow, 1).Value = .Cells(edRow + 1, 1).Value
　　　 edRow = edRow + 1
　　Loop
　　Application.Union(.Range(.Cells(stRow, 1), .Cells(edRow, 2)), _
　　.Range(.Cells(stRow, fR.Column), .Cells(edRow, fR.Column))).Copy
　　Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　On Error Resume Next
　　ws.Name = .Cells(stRow, 1).Text & "-" & fR.Text
　　ws.Range("A1") = .Range("A1"): ws.Range("B1") = .Range("B1")
　　ws.Range("C1") = .Range(fR.Address)
　　ws.Range("A2").PasteSpecial xlPasteAll
　　Application.CutCopyMode = False
　　stRow = edRow + 1
　　.Activate
　Loop
End With
End Sub

お礼

回答ありがとうございます。
うーん、勉強不足のせいでしょう。難しいですね。
これを参考にがんばってみます。