[[20061210122453]]　『業務日報から個別のファイルへ転記させたい』（さつまの梅酒．）　ページの最後に飛ぶ

『業務日報から個別のファイルへ転記させたい』（さつまの梅酒．）

毎日の日誌

１２月　１日

氏名Ａ　　内容　ああああ

氏名Ｂ　　内容　ｓｓｓｓ

氏名Ｃ　　内容　ｌｌｌｌ

が入力された日誌から

個別氏名Ａファイル　　　　　　　

日付　内容

　　　　　　　　　　　
12/1　あああああ　
　　　　　　
　
12/2

　　　　　　　　　　　　　　
12/3

　　　　　　　　　　　　　　
12/4

個別　氏名Ｂファイル

日付　内容

12/1　ｓｓｓｓ

12/2

12/3
　
というように作成したいのですが，どうすればよいでしょうか？

 このような日報があって
 ファイル名：業務日報
	A	B	C
1	12月1日		
2	氏名Ａ	内容	ああああ
3	氏名Ｂ	内容	ｓｓｓｓ
4	氏名Ｃ	内容	ｌｌｌｌ

 これを
 個別氏名Aファイル		
	A	B
1	日付	内容
2	12月1日	ああああ
3	12月2日	
4	12月3日

 個別氏名Bファイル		
	A	B
1	日付	内容
2	12月1日	ｓｓｓｓ
3	12月2日	
4	12月3日

 と個別ファイルにしたいということですか？

はい，そのとうりです

 全部のブック(ファイル）が開いているものとします。
 開いていないのなら、また別な方法になります。
 マクロは業務日報の標準モジュールに記述してください。
 個別ファイル(個人）のファイル名は個人名としてください。
 1行目だけに項目行があるものとします。
	A	B
 1	日付	内容
 ↑
 これだけ

 Sub test()
    Dim myDate As String
    Dim myR As Range, r As Range
    Dim FR

    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("Sheet1")
        myDate = Format(.Range("A1").Value, "m月d日")
        Set myR = .Range("A2", .Range("A65536").End(xlUp))
    End With
    For Each r In myR
        With Workbooks(r.Value & ".xls").Sheets("Sheet1")
            With .Range("A65536").End(xlUp).Offset(1)
                .Value = myDate
                .Offset(, 1).Value = r.Offset(, 2).Value
            End With
        End With
    Next
    Application.ScreenUpdating = True
End Sub
                （SHIOJII)

ありがとうございます．
できれば，業務日誌以外の個別ファイルは閉じたままで使用したいのですが，こちらの方法も教えてください

 業務日誌と同じフォルダに個人ファイルは入れておいてください。

 Sub test2()
    Dim myDate As String
    Dim myR As Range, r As Range
    Dim myPath As String

    Application.ScreenUpdating = False
    myPath = ThisWorkbook.Path & "\"
    With ThisWorkbook.Sheets("Sheet1")
        myDate = Format(.Range("A1").Value, "m月d日")
        Set myR = .Range("A2", .Range("A65536").End(xlUp))
    End With

    For Each r In myR
        Workbooks.Open (myPath & r.Value & ".xls")
        With ActiveWorkbook.Sheets("Sheet1")
            With .Range("A65536").End(xlUp).Offset(1)
                .Value = myDate
                .Offset(, 1).Value = r.Offset(, 2).Value
            End With
        End With
        ActiveWorkbook.Close True
    Next
    Application.ScreenUpdating = True
End Sub

ありがとうございました

コメント返信：

[ 一覧(最新更新順) ]

[[20061210122453]] 『業務日報から個別のファイルへ転記させたい』（さつまの梅酒．） ページの最後に飛ぶ

[[20061210122453]]　『業務日報から個別のファイルへ転記させたい』（さつまの梅酒．）　ページの最後に飛ぶ