[[20090224132033]]　『シート1からシート2に条件つきで自動に反映させた』（sasasachi）　ページの最後に飛ぶ

『シート1からシート2に条件つきで自動に反映させたいです』（sasasachi）

 　
やりたい事〉シート1に日付・科目・摘要・金額を毎日入力していきます。（科目はバラバラです。）
シート1に入力した科目情報で、シート2～に作成した科目別元帳に、日付・金額・摘要を自動的に反映させたいのです。
例）シート1
Ａ列　Ｂ列　Ｃ列
1/1　備品　　￥500（実際には￥入れてません）
1/3　保険　　￥1000
1/5　備品　　￥500　　と入力したら、自動的に
シート2
Ａ列　Ｂ列　Ｃ列
1/1　　備品　￥500
1/5　　備品　￥500　　と入力される。ようにしたいです。
　
ご指導おねがいします。（出来れば、総会3/1には完成、印刷までしたいので急いでます）

 以前のコメントですが。
[[20081218145320]]『データを品名別に別シートに自動的に入力したい』（山田）

 書式も一緒にの場合はこちらを。
[[20090127164751]]『別シートのデータにセルの色を反映』（やま）

 (HANA)

 衝突。。。

 こんな感じでどうでしょうか。
元に戻せなくなりますので、Bookを複製してからお試し下さい。
(ROUGE)
'----
Sub test()
Dim tbl, i As Long, ii As Long, x, ws As Worksheet
tbl = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 3).Value
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tbl, 1)
        If .Exists(tbl(i, 2)) Then
            x = .Item(tbl(i, 2))
            ReDim Preserve x(1 To 3, 1 To UBound(x, 2) + 1)
            For ii = 1 To 3
                x(ii, UBound(x, 2)) = tbl(i, ii)
            Next
            .Item(tbl(i, 2)) = x
        Else
            ReDim x(1 To 3, 1 To 1)
            For ii = 1 To 3
                x(ii, 1) = tbl(i, ii)
            Next
            .Add tbl(i, 2), x
        End If
    Next
    For Each ws In Sheets
        If ws.Name <> "Sheet1" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next
    For Each x In .Keys
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        ws.Name = x
        ws.Range("A1").Resize(UBound(.Item(x), 2), 3).Value = _
            Application.Transpose(.Item(x))
    Next
End With
End Sub

早い対応ありがとうございます（＞＜）初心者なので、マクロ？？などは苦手ですが、
コピー貼り付けで使用させていただきます。ありがとうございます。

コメント返信：

[ 一覧(最新更新順) ]

[[20090224132033]] 『シート1からシート2に条件つきで自動に反映させた』（sasasachi） ページの最後に飛ぶ

[[20090224132033]]　『シート1からシート2に条件つきで自動に反映させた』（sasasachi）　ページの最後に飛ぶ