エクセルでマクロにてセル色と文字を他シートのセルへコピーしたい

他質問者様へのご回答を検索し、自分なりに挑戦してみましたがVBA初心者の為うまくいかず、どなたかご指導いただけないでしょうか。

現在エクセルにて、sheet1のA1からA5000のセルに入力した文字と色(他書式は必要ありません)をsheet2のF1からF5000へ自動でコピーという動作を何ヶ所かしたいのですが、マクロのコードを教えて下さい。

お時間のある方、どうぞ宜しくお願いします。

No.3 ベストアンサー 回答者： myRange 回答日時： 2009/06/22 17:25

またまた登場、myRangeです。

＞色のコピーが上手くいきません

「文字」の色をちゃんとコピーしてますが、
まさか「セル」の色と勘違いるのではないでしょうねぇ。
質問には、「文字」の色とありますよね。

　●今回のサンプルでは、セルの色　にしてあります●
　

＞A列をF列へ、B列をG列へ、C列をH列へという感じです。

この組み合わせが少なければ
下記のように、列を変えて必要な分だけコピーすればいいですね。

'--------------------------------------------
Sub Test3333()
Dim R As Long

Sheets("Sheet1").Select

For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Cells(R, "F").Value = Cells(R, "A").Value
Sheets("Sheet2").Cells(R, "F").Interior.ColorIndex = Cells(R, "A").Interior.ColorIndex
Next R

For R = 1 To Cells(Rows.Count, "B").End(xlUp).Row
Sheets("Sheet2").Cells(R, "G").Value = Cells(R, "B").Value
Sheets("Sheet2").Cells(R, "G").Interior.ColorIndex = Cells(R, "B").Interior.ColorIndex
Next R

For R = 1 To Cells(Rows.Count, "C").End(xlUp).Row
Sheets("Sheet2").Cells(R, "H").Value = Cells(R, "C").Value
Sheets("Sheet2").Cells(R, "H").Interior.ColorIndex = Cells(R, "C").Interior.ColorIndex
Next R

End Sub
'---------------------------------------------------


組み合わせが多ければ、また別な方法があります。
更に言えば、規則的であれば、また別な方法もあります。
が、それらは、先ず、上記サンプルのような基本的な使い方を理解してからでいいのでは、
と考えます。
以上ここまで。

この回答へのお礼

myRange様
無事に処理出来ました。言葉足らずで申し訳ございません。文字とセル色とお伝えするべきでした。
しかし、前回ご教授頂いた文字の色も今回一緒にコードに入れることにしました。
大変分かりやすいご回答で全て無事に解決しました。有難うございました。

お礼日時：2009/06/23 12:55

No.2 回答者： myRange 回答日時： 2009/06/22 14:05

＞自動でコピーという動作を何ヶ所かしたい

この「何ヶ所かしたい」という具体的な提示がないと
的確な回答はできませんが、ま、参考ということで。

（処理内容）
Sheet1のＡ１～～データの最終行までの、値と文字色を
Sheet2のＦ１～～　にコピーする

'---------------------------------------------
Sub Test()
　Dim R As Long
　Dim LastRow As Long

　Sheets("Sheet1").Select
　LastRow = Cells(Rows.Count, "A").End(xlUp).Row

　For R = 1 To LastRow
　　Sheets("Sheet2").Cells(R, "F").Value = Cells(R, "A").Value
　　Sheets("Sheet2").Cells(R, "F").Font.ColorIndex = Cells(R, "A").Font.ColorIndex
　Next R

End Sub
'--------------------------------------------

データの最終行が何行目であっても対応できるように
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
このようなコードで最終行を自動取得します。

以上ここまで。
　

この回答への補足

myRange様
ご回答ありがとうございます。
説明不足で申し訳ないです。

何ヶ所かについてですが、全てsheet1からsheet2へのコピーで、A列をF列へ、B列をG列へ、C列をH列へという感じです。

早速試してみました。
入力文字は完璧にコピーされ、感動致しました。しかし、色のコピーが上手くいきません。
お時間ある時でも考えられる原因をご教授頂けますでしょうか。

宜しくお願い致します。

補足日時：2009/06/22 15:18

No.1 回答者： WDY 回答日時： 2009/06/22 13:12

文字と色をコピーしたいけど、書式はコピーしたくないとの質問でしたが色は書式に含まれてしまっているので

値のコピーをした後に色のコピーをしてはどうでしょう？

コードはこんな感じかな
例
dim row as doubule
dim color as integer
Sheets("Sheet1").Range("A1:AA5000").Select
Selection.Copy
Sheets("Sheet2").Range("F1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

　　Sheets("Sheet1").Range("A1").Select

for row=1 to 5000
If Range("A" & row).Interior.ColorIndex > 0 Then
color=Range("A" & row).Interior.ColorIndex
Sheets("Sheet2").Range("F" & row).Select
With Selection.Interior
.ColorIndex = color
.Pattern = xlSolid
End With
Sheets("Sheet1").Range("A" & row).Select
endif
next

即席で作ったのでテストしてませんが流れはわかると思います。

この回答への補足

早速のご回答ありがとうございます。

ＷＤＹ様からのコードを試してみましたが、下記コードの所でつまずいてしまいました。入力の仕方が悪かったのでしょうか。初心者なもので、せっかく教えて頂いたのにご大変申し訳ないです。
paste:=xlValues,
operation:=xlNone,

など「:=」や「,」が付く辺りがうまくいきません。何が原因かお分かりでしょうか…

補足日時：2009/06/22 14:56

この回答へのお礼

WDY様
おかげさまで今回の件は無事に解決することが出来ました。これからもっと勉強していきます。
大変有難うございました。

お礼日時：2009/06/23 12:58