[[20050919184545]]　『VBAでパターンのコピペしたい』（non27）　ページの最後に飛ぶ

『VBAでパターンのコピペしたい』（non27）Excel2003 WinXP

度々お世話になります。
VBAであるセルの値をコピーして塗りつぶし属性（Interior.Color）やパターン（Pattern )（前者に含むのかな？）のみ（値や罫線等他の書式は変えずに）複数のセルに貼付けしたいのです。
よろしくお願いします。

 パターンの属性を直接引っ張ってくるという手もあります。
 下記のサンプルはB2:C5のパターンに現在選択されているセルの
 パターンを適用するものです。

 Sub Macro1()
  Dim c As Range
  Dim r As Range
   Set c = Selection
   Set r = ActiveSheet.Range("b2:c5")
     With r.Interior
         .ColorIndex = c.Interior.ColorIndex
         .Pattern = c.Interior.Pattern
         .PatternColorIndex = c.Interior.PatternColorIndex
     End With
 End Sub
 (MARBIN)

 Inputboxメソッドを使ったパターンコピーのサンプルです。
 予めパターンをコピーする先のセルを選択しておいてマクロ
 を実行し、Inputboxでコピー元を指定します。

A2

 という風に指定します。
 アルファベット部分は小文字ではなく大文字で指定します。

  Sub Test()
   Dim c As Range
   Dim r As Range
    On Error Resume Next
    Set c = Application.InputBox("コピー元セル", Type:=8)
     If c Is Nothing Then Exit Sub
    On Error GoTo 0
    Set r = Selection
      With r.Interior
          .ColorIndex = c.Interior.ColorIndex
          .Pattern = c.Interior.Pattern
          .PatternColorIndex = c.Interior.PatternColorIndex
      End With
  End Sub
 (MARBIN)

 MARBINさん早速回答ありがとうございました。
　お返事が遅れまして申し訳ありません。
　お陰さまでパターンのコピペが出来ました。
　お世話になりついでにもう一つ教えてください。
　
　Sub 休日()
    Dim C, R As Range
    Set C = ActiveSheet.Range("N2")
    Set R = Selection
     With R.Interior
         .ColorIndex = C.Interior.ColorIndex
         .Pattern = C.Interior.Pattern
         .PatternColorIndex = C.Interior.PatternColorIndex
     End With

　End Sub

　これで動作するのですが、欲を言えば複数個所のSelectionの同じ列の6行目から
　85行目までを再セレクションして貼り付けたいのです。
　何から何までお世話になりますがよろしくお願いします。

 Set C = ActiveSheet.Range("N2")
 MyC = Selection.Column
 Set R = Range(Cells(6,MyC),Cells(85,MyC))

 では、どうですか。

 （川野鮎太郎）

 川野鮎太郎さん早速の回答ありがとうございます。
 私のやり方が悪いのか言葉が伝わっていないのか良く分かりませんが、
 例えばC5～C6、C10～C11等複数個所飛んで選択した場合左の1列しか張り付きません。
 どこか違っているのでしょうか。
 (non27)

 えっと・・・、C5～C6、C10～C11　では、1列だけですが、
 仮にC,F,Gなどの複数列ってことでしょうか。
 であれば、
　
Sub Test()
Dim c As Range
Dim r As Range
Dim MyRng As Range
Dim MyC As Long
Set c = ActiveSheet.Range("N2")
For Each MyRng In Selection
    MyC = MyRng.Column
    Set r = Range(Cells(6, MyC), Cells(85, MyC))
    With r.Interior
        .ColorIndex = c.Interior.ColorIndex
        .Pattern = c.Interior.Pattern
        .PatternColorIndex = c.Interior.PatternColorIndex
    End With
Next MyRng
End Sub

 これでいけますか。

 （川野鮎太郎）

 最後までありがとうございました。
 C5～D5、と書くつもりが間違ってすみませんでした。でも、ちゃんと分かって頂けて
 嬉しいです。
 これで完璧に動作しました。
 (non27)

コメント返信：

[ 一覧(最新更新順) ]

[[20050919184545]] 『VBAでパターンのコピペしたい』（non27） ページの最後に飛ぶ

[[20050919184545]]　『VBAでパターンのコピペしたい』（non27）　ページの最後に飛ぶ