Excel　抽出データを別シートに移す方法

Question

アルバイトの方の勤怠管理のためにタイムカードレコーダーを使っていて、
毎月その内容をExcelに出力しています。

A　　　B　　　　　C　　　　　　　D　　　　E　　　F　　　　G
------------------------------------------------------------
番号　氏名　　　日付　　　　　出勤　　外出　　戻り　　退勤
1　　伊藤太郎　2005/1/16　　8:55　　　　　　　　　　　16:35
1　　伊藤太郎　2005/1/17　　8:52　　　　　　　　　　　16:40
　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　・
2　　佐藤花子　2005/1/16　　9:48　　　　　　　　　　　15:07
2　　佐藤花子　2005/1/17　　9:51　　　　　　　　　　　15:10
　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　・

１つのファイルの中にすべてのアルバイトさんのデータが出力されて
いるのですが、個人毎にデータを保存しておきたいので、毎回オートフィルタで
１人ずつデータを抽出して別シートにコピーしています。しかし、アルバイト
さんの数が増えるにつれて作業量＆時間も増えてきてしまいました。
この作業をマクロやＶＢＡで自動化できれば・・・と思うのですが、何かよい
方法はありますでしょうか。

説明が足りない部分がありましたらご指摘ください。よろしくお願いいたします。

matsu_jun · Accepted Answer

#2のmatsu_junです。作ってみました。これ以上になるとお仕事になっちゃうから、このくらいで勘弁してね。くれぐれも、罫線も引きたいとか、一番下の行に合計を表示させたいとか言わないでね。。。
細かな検証もしてないから、変な動作をしてしまっても怒らないでね。間違った操作をすると元データが消えちゃうから、ちゃんとバックアップをとってから作業をしてね。

Sub 個人別データ作成()
    '余計なシートを削除する。
    i# = 1
    Application.DisplayAlerts = False
    Do While Worksheets.Count > 1
        If Worksheets(i).Name = "元データ" Then i = 2
        Worksheets(i).Delete
    Loop
    Application.DisplayAlerts = True
    
    For i = 2 To Worksheets("元データ").Cells(65536, 2).End(xlUp).Row
        j# = 1
        
        '検索中の人のシートが既にできているかを判断する。
        For Each sheet_name In Worksheets
            If sheet_name.Name = Worksheets("元データ").Cells(i, 2).Value Then
                j = 2
                Exit For
            End If
        Next
        If j = 1 Then  '検索中の人のシートがない場合、新規に作成する。
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = Worksheets("元データ").Cells(i, 2).Value
            For j = 1 To 7
                Worksheets(Worksheets.Count).Cells(1, j).Value = Worksheets("元データ").Cells(1, j).Value
            Next j
            Worksheets(Worksheets.Count).Columns("D:G").NumberFormatLocal = "h:mm;@"
        End If
        
        'データコピー部
        For j = 7 To 1 Step -1
            Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
            Cells(Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
            Cells(65536, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value
        Next j
    Next i
    
    'それぞれのシートの列幅を最適化します。
    For Each sheet_name In Worksheets
        sheet_name.Columns("A:G").AutoFit
    Next
End Sub

telescope · Answer

ピボットテーブルでかなり省力化できると思います。

「データ」－「ピボットテーブルとピボットグラフ　レポート」を選択します。
分析するデータのある場所に　〔Excelのリスト/データベース〕
作成するレポートの種類に　〔ピボットテーブル〕
を選び【次へ】

使用するデータの範囲を指定します。
データの範囲内にカーソルがあればExcelが自動的に範囲を表示しますが、
将来入力する分を見越して多めに指定します。
入力してあるデータの範囲が、　$A$1:$H$50　の範囲であっても、
$A$1:$H$300　のように余分に指定しておきます。
後で追加したデータもボタンを押すだけで更新されますので、そのためです。

【次へ】ボタンを押して、
新規ワークシートを選んで、【完了】ボタンを押します。

行のフィールドに　日付、出勤、外出、戻り、退勤をそれぞれドラッグします。
ページのフィールドに　氏名　をドラッグします。
データフィールドに　出勤　をドラッグします。
出勤した数が表示されます。元のデータにないものですが、これがないと表が出来ません。
出勤日数がわかりますので、使ってください。

「2005/1/16　計」、「(空白)　計」などと、それぞれの計が表示されますが、
「2005/1/16計」と書かれたセルで右クリックして、「表示しない」を選びます。
「○○　計」と書かれたセルをすべて「表示しない」にします。
日付の列の一番下に「(空白)」の行がありますので、これも「表示しない」にします。

ピボットテーブルツールバーにある「ピボットテーブル」ボタンの▼をクリックして、「ページの表示」を選びます。
ページフィールドに「氏名」が表示されていることを確認して、OKボタンを押します。
氏名ごとのシートが一気に出来上がります。

「表示しない」設定は、それぞれのページで生きています。
残念ながら、条件付き書式は、それぞれのシートで設定しなければならないようです。
元のデータの空白欄は、(空白)と表示されますが、これが邪魔でしたら、
条件付き書式で設定します。
「セルの値が」、「次の値に等しい」にして
(空白)と入力します。カッコは半角です。
書式のフォントの色を「白」にします。

(空白)というシートも作成されますが、このシートは削除します。

データを追加したときは、ピボットテーブルの表の範囲内のどれかのセルを選択した状態で、
ピボットテーブルツールバーにある赤い「！」をクリックすると更新されます。

表の見映えが、元の表と少し変わってしまいますが、省力化は出来ると思います。

chal · Answer

マクロの記録機能を使うと良いと思います。

１．全てのデータがあるシートを開いておく。
２．マクロの記憶機能を開始する。
３．ある人の名前でフィルタを掛け、別シートを作成する。
４．マクロの記憶機能を終了する。

　マクロがある程度分かる人なら、ここからEditorを開き、少しアレンジすれば必要な人数分の処理を行うことが簡単に出来ると思います。
　あまり分からないようでしたら、力技になってしまいますが、上記３を人数分繰り返せば良いかと。

matsu_jun · Answer

本当に必要最小限のマクロソースを以下に示しますので、あとはここからいろいろな機能を追加してみてください。
元データの入っているシート名を「元データ」に、後はアルバイトの人の名前のシートをアルバイトの人数分用意してください。sheltieさんの例であれば、「元データ」「伊藤太郎」「佐藤花子」という名前の3枚のシートを作成していただくことになります。
以下のコードを標準モジュールに貼り付けて実行してみてください。
詳しい説明は必要であればいたしますが、簡単に言えば、元データの2列目の名前を、2行目から順番に見ていき、同じ名前のシートに1行ずつ貼り付けていくという操作を、元データの最下行(入力されている中の最下行)まで繰り返すというものです。


Private Sub 個人別データ作成()
    For i# = 2 To Worksheets("元データ").Cells(65536, 2).End(xlUp).Row
        For j# = 7 To 1 Step -1
            Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
            Cells(Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
            Cells(65536, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value
        Next j
    Next i
End Sub


あとは、罫線が必要かどうか、再実行するときに一度シートのデータをクリアするかなど、やりたいことに応じてソースを追加していってください。
貼り付け方が分からない時はこの欄にて、補足要求をしてくださいませ。

BLUEPIXY · Answer

抽出先を別シートにするには、
抽出先のシートで、データ～フィルタ～フィルタオプションの設定をします。

Excel 抽出データを別シートに移す方法

#2のmatsu_junです。

ピボットテーブルでかなり省力化できると思います。

マクロの記録機能を使うと良いと思います。

本当に必要最小限のマクロソースを以下に示しますので、あとはここからいろいろな機能を追加してみてください。

この回答への補足

抽出先を別シートにするには、

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

Excel　抽出データを別シートに移す方法

　マクロの記録機能を使うと良いと思います。