エクセルでの質問です。お願いします。

質問

シート１には縦軸の所に名前が７０人くらい最初から入れてあり
横軸には日にちを３１日まで最初から書いてあり
日にちと名前が合うところにinとout時間をいれると（画像参照）

日付が合うシートの表に自動的に上に詰めて名前とinとoutが反映されるようにしたいのですが・・
できなく、困っています。
しかも９時～１１時と１２時～１５時と１６時以降と
三つに分かれてそれぞれに反映したいです。

シート２（10月１日）
　　　　９－１１　　　in　　out　　　１２－１５　　　in　　out　　１６～　　　　in　　out　
1　　　山田太郎　　9　　18　　　　　　　　　　　　　　　　　　　　斎藤四郎　17　　23
2

シートは3１日分あります。出勤時間を入れるシート（ここではシート１）そして
日にち分のシート３１枚で合計３２シートで構成されるものを考えています。

日にち（10月2日とか）のシートを見ればその日に誰が何時に出勤するかわかるようにしています。

何卒よろしくお願いいたします。

回答No.1

K Kazz（@JazzCorp）

中間報告、、、
Sub ExtractColumns()
Const xMaster = "Sheet1"
Const xEndMonth = 31
Dim xSheet As Worksheet
Dim xRange As Range
Dim xLast As Long
Dim kk As Long
Dim nn As Long
Dim xNoData As Boolean
Dim xReply As Integer
On Error Resume Next

'Application.ScreenUpdating = False
Application.DisplayAlerts = False
xReply = MsgBox("始めマッセ？？", vbYesNo)
If (xReply = vbNo) Then Exit Sub
xNoData = True
MsgBox "現在のシート数：" & Worksheets.Count
'xMaster以外を削除
For Each xSheet In Worksheets
If (xSheet.Name = xMaster) Then
xNoData = False
Else
xSheet.Delete
End If
Next
If (xNoData) Then
'Worksheets.Add before:=Worksheets(1)
'Worksheets(1).Name = xMaster
MsgBox "No Data found!!"
End If
'日単位のシート作成
For nn = 1 To xEndMonth
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set xSheet = Worksheets(nn + 1)
xSheet.Name = nn & "日"
With Worksheets(1)
xLast = .Cells(Rows.Count, "A").End(xlUp).Row
.Range(.Cells(1, "A"), .Cells(xLast, "B")).Copy Destination:=xSheet.Range(xSheet.Cells(1, "A"), xSheet.Cells(xLast, "B"))
kk = 3 + (nn - 1) * 2
.Range(.Cells(1, kk), .Cells(xLast, kk + 1)).Copy Destination:=xSheet.Range(xSheet.Cells(1, "C"), xSheet.Cells(xLast, "D"))
End With
'出勤予定以外を削除
xLast = xSheet.Cells(Rows.Count, "A").End(xlUp).Row
For kk = xLast To 5 Step -1
If Application.WorksheetFunction.CountA(xSheet.Range("C" & kk & ":D" & kk)) = 0 Then
xSheet.Rows(kk).Delete
End If
Next kk
xLast = xSheet.Cells(Rows.Count, "A").End(xlUp).Row
MsgBox ("Sheet：" & xSheet.Name & vbNewLine & "Rows.Count：" & xLast)
Next nn
MsgBox "現在のシート数：" & Worksheets.Count
GoTo Skip

'シフト分割処理
'to be continue...

Skip:
Worksheets(2).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.CutCopyMode = False
End Sub

お礼

回答ありがとうございます。
しかしながらこれは何をしているのでしょうか？
マクロってやつですか？全くの素人でどうしていいのか…すみません。

自分でやったのは
=IF(SUMPRODUCT((記入!$D$5:$D$120>=9)*(記入!$D$5:$D$120<=11)*(記入!$B$5:$B$120=$B$1))>=ROW(D1),INDEX(記入!$D$1:$D$120,SMALL(IF((記入!$D$5:$D$120>=9)*(記入!$D$5:$D$120<=11)*(記入!$B$5:$B$120=$B$1),ROW(記入!$D$5:$D$120),""),ROW(D1))),"")

関数を使ってやろうとしたんですが…できなく今回教えてgooさんに依頼しました。

できればギガファイルなどにエクセルのデータを入れてもらうなどしていただくと嬉しいのですがそれは難しいでしょうか？
メールでもいいのですが、ダイレクトメールとかってないのでしょうか？
すみません、教えてgooも最近やり始めたので勝手がわからず…

手順を教えていただけたら幸いです。

生意気言ってすみません。