表の数行の列を抜き出し一覧作成マクロ

質問

電話回線の仕事をしていますが、
別チームから
「送られてきた請求書がどれか分からないので、電話会社からの請求書の宛名に、お客様の名前を入れてほしい」
と言われました。

宛名に書くと、お客様の社名がもろに表出されているため、
セキュリティ上良くないと考え、
案件に所定の工番をつけ、それと照合で分別してもらおうと思います。

Excel2003で作成されている契約一覧の表があるのですが、
ここから
・案件番号
・顧客名
・請求書送付住所
etc…
といった、必要な数行の列だけ抜き出し、一覧を別途作成して別チームに渡したいです。

行は日々更新されますので、
最新までの範囲でいくつかの列を抜き出せるマクロを作りたいのですが、
どう作ったらいいか全く分からず。

該当するマクロが載っているHPか、マクロその物をご紹介いただけないでしょうか。

よろしくお願いいたします。

回答No.2

KURUMITO · ベストアンサー

例えばあるシートに表があるとして1行目には項目名が有るとします。その中からお望みの項目名についてのデータを別のシートに抜き出して表示したいとのことでしたら次のようなマクロで良いでしょう。

Sub 項目の選択とコピー()

Dim WS1 As String
Dim WS2 As String
Dim Coln1 As Integer
Dim Coln2 As Integer
Dim Inp As String
Dim Row1 As Integer

WS1 = ActiveSheet.Name
WS2 = InputBox(Prompt:="コピーをするにあたって初めにコピー先のシート名を入力してください")

Do
Inp = InputBox(Prompt:="選択する項目名を記入してください。選択する項目を終了する場合には空のままクリックしてください")
If Inp = "" Then
Worksheets(WS1).Activate
Range("A1").Select
Exit Sub
End If
If Worksheets(WS2).Range("A1") = "" Then
Coln2 = 1
Else
Coln2 = Worksheets(WS2).Cells(1, 256).End(xlToLeft).Column + 1
End If

Worksheets(WS1).Activate
Range("A1").Select
If WorksheetFunction.CountIf(Worksheets(WS1).Range("A1:XX1"), Inp) > 0 Then
Coln1 = WorksheetFunction.Match(Inp, Worksheets(WS1).Range("A1:XX1"), 0)
Row1 = Cells(65536, Coln1).End(xlUp).Row
Range(Cells(1, Coln1), Cells(Row1, Coln1)).Copy Destination:=Worksheets(WS2).Cells(1, Coln2)
Application.CutCopyMode = False
Range("A1").Select
Else
MsgBox "入力した項目名は存在しません。入力をやり直してください。"
End If
Loop

End Sub

補足

作成ありがとうございます。
同BOOKに”請求”シートを作成し、タイトルはA10からAP10まで各10行になっていたのでカスタマイズしましたが、 "入力した項目名は存在しません。入力をやり直してください。"が出てしまします。
いろいろ試してみましたが、コピーされません。
どうしたらよろしいでしょう？

回答No.3

KURUMITO

回答No1,2です。
元のシートでは1行目に項目名が記載されていることが必要ですし、その項目名がマクロで入力するときの項目名と一致していることが必要です。
それでも項目がないとのメッセージが出るのでしたら元のシートの項目名について一度手書きで入力してみてください。項目名の前後にスペースなどがついている場合になどは一致しないことになります。

回答No.1

KURUMITO

契約一覧の表はどのようになっているのでしょう。日付などがはいいてると思うのですが。必要な数行と言っておりますがどの項目が必要で抜き出す条件はどのようなものでしょう。。マクロを組むまでもなく関数で十分対応ができる内容と思います。

補足

申し訳ありません。
リンクでは都合が悪いので、やむ得ず別のファイルを生成したいため、
マクロが必要と考えております。
VBは全く分からない訳ではありませんので、
とりあえずある列を更新された最終行まで転記し、
次の転記する列を指定して
また更新最終行まで転記を繰り返すというマクロが欲しいです。

質問後もちょうどいいマクロを探していますが見つからず、
自作の勉強HPも同時に捜索中ですが、
一人では時間がかかるのでご教示いただければ幸いです。