背景色付きセルを他のシートに抽出したい。

質問

VBAは初心者です。環境はWINDOWS-XP、エクセル2003です。
よろしくお願い致します。

まず、背景ですが、営業週報をエクセルで管理しています。
シート１、シート２、シート３がそれぞれ客先にあたります。
（客先はもっと沢山ありますが、ここでは仮にシート３まで）

毎週各シートから更新部分をコピペするのが面倒なので、
シート４にそれぞれの客先の更新された部分のみ抽出する
ボタンを作成して、マクロを登録しようと考えています。

更新した部分は背景色をつけるので、その背景色を条件として
判断し、抽出させるのが良いかと考えています。

エクセルの画面は下記のような感じです。

【シート１～３】
　　A　　　　　　　B　　　　
1 　案件名　　　ほにゃららAAA
2　１０月１日　　商談内容１
3　１０月１１日　商談内容２
4　１０月２０日　商談内容３（背景色：黄色）
5
6 　案件名　　　ほにゃららBBB
7　１０月２日　　商談内容１
8　１０月１２日　商談内容２
9
10 　案件名　　　ほにゃららCCC
11　１０月２日　　商談内容１
12　１０月２０日　商談内容２（背景色：黄色）

各シートを読み込んで、背景色が黄色になっているセルをコピーし、
シート４にそのセル内の文字を吐き出すにはどのようにプログラム
すれば良いでしょうか。

また、更新されている案件名（上記例、ほにゃららAAA、ほにゃららCCC ）も、
同じように抽出するにはどのようにすれば宜しいでしょうか。

お知恵をお借りしたく、よろしくお願い申し上げます。

回答No.4

nekoron07 · ベストアンサー

No.1です。

マクロのどの位置（何行目）でエラーが出ているかわかりますか？
（エラーメッセージのあとで「デバッグ」のボタンを押すと、VBエディタが開き、問題となっている行が黄色で示されます。）

それと、ここから先は想像ですが。

シート名はもとの「sheet1」～「sheet4」のままですか？
それとも名前を変えておられますか？
もしシートの名前を変えておられるのでしたら、マクロ記述の3行目の

　　sheets("sheet1").select

の「sheet1」の部分をその名前に、また14行目の

　　Sheets("Sheet4").Select

の「sheet4」の部分をデータの書き出しを行うシートの名前に変えてみてください。

お礼

できました！！！
ヽ(´∀｀*)ノワーィヽ(*´∀｀)ノワーィ

ありがとうございました。
非常に助かりました！

回答No.3

nekoron07

No.1です。
すみません、ボタンはシート1に作られると想定して作りました。
シート4に作られたのでしたら、下記のようにマクロの3行目に1文を加えてください。

※マクロの中にA（案件名を保存する）とS（内容を保存する）という変数を作って、その中にデータをコピーして貼り付けしていますので、「Copy」や「Paste」は必要ないのです。この方が処理が早いのでこのようにしています。

Sub Macro1()
Dim A, S

　　sheets("sheet1").select
　　Range("A1").Select

　　…以下は先ほどのとおり。

補足

ありがとうございます。

３行目に
sheets("sheet1").select
を追加して実行致しました。

今度は
「インデックスが有効な範囲にありません」
というエラーメッセージが表示され上手くいきません（ＴＴ）

回答No.2

imogasi

＞更新した部分は背景色をつけるので、その背景色を条件として
判断し
その通りコードを組めばよいと思いますよ。この点だけには難しいことはない。
Range(セル）のInterior.ColorIndex が決まったコードかどうか
聞いてTRUEなら
そのセルの値（多分商談内容）と、関連して書き出さなければならない、案件名、日付などを書き出す（ｘ）。
上記の（ｘ）の部分のコードはシコシコと書いてゆく世界で、アイデアも何もない。
またこの質問にも書いてないし、質問者が一番良くわかっている内容でしょう。
ーー
エクセルでということで、仕方がないのでしょうが、私の経験した
面談システムは、質問とは逆に、本件質問で抽出結果のような内容を入力し、データベースにためて、過去の情報や付帯情報などと組み合わせて、レポートを作成というものでした。
＞更新した部分は背景色をつけるので
これは各担当者などに十分守られるのでしょうかね。
入力シートがどんなものかわからないのですが。
こういう業務はエクセルでは処理しづらいのでは。

回答No.1

nekoron07

細かい設定がわかりませんが、とりあえずシート1の黄色（色コード6）のセルをシート4にコピーするマクロです。
シート2、シート3についてはできれば質問者様で改造して作ってみてください。
シート4のどの位置に出力したいとか、ここはこうしたい、とかがあればまたどうぞ。

Sub Macro1()
Dim A, S

　　Range("A1").Select
　　Do While ActiveCell <> "" Or ActiveCell.Offset(1, 0) <> ""
　　　　If ActiveCell = "案件名" Then
　　　　　　ActiveCell.Offset(0, 1).Range("A1").Select
　　　　　　A = ActiveCell
　　　　　　ActiveCell.Offset(1, -1).Range("A1").Select
　　　　Else
　　　　　　ActiveCell.Offset(0, 1).Range("A1").Select
　　　　　　If ActiveCell.Interior.ColorIndex = 6 Then
　　　　　　S = ActiveCell
　　　　　　Sheets("Sheet4").Select
　　　　　　Range("A1").Select
　　　　　　Do While ActiveCell <> ""
　　　　　　　　ActiveCell.Offset(1, 0).Range("A1").Select
　　　　　　Loop
　　　　　　ActiveCell = A
　　　　　　ActiveCell.Offset(0, 1).Range("A1").Select
　　　　　　ActiveCell = S
　　　　　　Sheets("Sheet1").Select
　　　　　　ActiveCell.Offset(1, -1).Range("A1").Select
　　　　Else
　　　　　　ActiveCell.Offset(1, -1).Range("A1").Select
　　　　End If
　　End If
　　Loop
End Sub

補足

ありがとうございます。

早速シート４にボタンを作成し、
上記マクロを登録して、ボタンを押して実行致しましたが、
何も起こりません。。。

黄色のカラーインデックスを27に変えて試しましたが、
やはり何も起こりません。。。

ところで上記プログラムを読むと、
「Copy」と「Paste」とも入っておりませんけれど、
そこが問題でしょうか。