[[20090127164751]]　『別シートのデータにセルの色を反映』（やま）　ページの最後に飛ぶ

『別シートのデータにセルの色を反映』（やま）

先日『一覧データを複数シートへ振り分け』
[[20090115134616]]
で質問をさせていただき下記の方法で無事解決したのですが
一覧データのセルに色を付けた場合その色も反映させることは
できるのでしょうか？
宜しくお願い致します。
WinXP Excel2003

 ThisWorkbookのモジュールに以下を貼り付け。
 '------
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim i As Long, ii As Long, xr As Long
    Dim asn As String, tbl, x
　
    If ActiveSheet.Name = "一覧" Then Exit Sub
　
    asn = ActiveSheet.Name
    tbl = Sheets("一覧").Range("A1").CurrentRegion
    ReDim x(1 To UBound(tbl, 1), 1 To 5)
    For i = 2 To UBound(tbl, 1)
        If tbl(i, 1) = asn Then
            xr = xr + 1
            For ii = 1 To 5
                x(xr, ii) = tbl(i, ii)
            Next
        End If
    Next
　
    Range("A1").CurrentRegion.Offset(1).ClearContents
    If xr = 0 Then
        MsgBox "データがありませんでした。"
    Else
        Range("A2").Resize(xr, 5) = x
    End If
End Sub
 '------

 こちらに変えてみるとどうでしょう。（編集しました。19:10)

 '------
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "一覧" Then Exit Sub
        Cells.Clear
    With Sheets("一覧")
        .Range("A1").AutoFilter Field:=1, Criteria1:=ActiveSheet.Name
        .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Copy Range("A1")
        .AutoFilterMode = False
    End With
End Sub

 '------

 (HANA)

(HANA) さん

ありがとうございます、
こんなに早く解決できて感謝しております。
ありがとうございました

(やま)

たびたび申し訳ありません、無事解決したのすが
シート全部見ている？らしく、ファイルサイズがとても大きくなってしまいます
(570KB→40MB)
何か方法はあるでしょうか？

宜しくお願い致します
(やま)

 むむ、済みません。
 ものぐさコードを書いていました。

 一応確認ですが、A列は手入力しますよね？
 （数式等が多めに入っている　なんて事は無いですよね？）
 上のコードをそのまま変更しましたので、
 もう一度やってみてもらえますか？

 (HANA)

 (HANA)さん
何度もすみませんでした
上記で無事解決できました、ありがとうございました
(やま)

コメント返信：

[ 一覧(最新更新順) ]

[[20090127164751]] 『別シートのデータにセルの色を反映』（やま） ページの最後に飛ぶ

[[20090127164751]]　『別シートのデータにセルの色を反映』（やま）　ページの最後に飛ぶ