[[20080728175840]]　『条件で振り分け』（みっちー）　ページの最後に飛ぶ

『条件で振り分け』（みっちー）

 在籍と退社とゆうシートがあり４行目からデーターが入っています。
 （両方とも同じ構成でセルの保護がかかっています）Ｌ列に退社と記入されたら次回
 シートを開いた時に、退社となっている列全てを退社シートにコピー貼り付けをし、
 在籍シートからは削除するマクロを考えているのですが上手くいきません。
 どう直したら良いのでしょうか？

 Private Sub Workbook_Open()

 　 Dim Ws1 As Worksheet
    Dim Ws2 As Worksheet
    Set Ws1 = Worksheets("在籍")
    Set Ws2 = Worksheets("退社")

 　 　　ActiveSheet.Unprotect Password:="12345"

 　   Ws1.Columns("L:L").AutoFilter Field:=1, Criteria1:="退社"
     Ws1.Range("A4", ActiveCell.SpecialCells(xlLastCell)).Copy
     Ws2.Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial
     Ws1.Rows("4:" & Range("A4").End(xlDown).Row).Delete Shift:=xlUp
     Selection.AutoFilter

           ActiveSheet.Protect Password:="12345", DrawingObjects:=True, _
            Contents:=True, UserInterfaceOnly:=True

 　　　  End Sub

 一部推測で、、、

 Private Sub Workbook_Open()

     Dim Ws1 As Worksheet
     Dim Ws2 As Worksheet

     Set Ws1 = Worksheets("在籍")
     Set Ws2 = Worksheets("退社")

     If [COUNTIF(在籍!L:L,"退社")] = 0 Then Exit Sub  '転記データの存在を確認

 '        ActiveSheet.Unprotect Password:="12345"

     Ws1.AutoFilterMode = False                       '念の為、オートフィルタ初期化

     Application.ScreenUpdating = False
         Ws1.Columns("L:L").AutoFilter Field:=1, Criteria1:="退社"

         Ws1.AutoFilter.Range.Offset(1).EntireRow.Copy
         Ws2.Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial
         Ws1.AutoFilter.Range.Offset(1).EntireRow.Delete Shift:=xlUp

         Ws1.AutoFilterMode = False
     Application.ScreenUpdating = True

 '           ActiveSheet.Protect Password:="12345", DrawingObjects:=True, _
             Contents:=True, UserInterfaceOnly:=True

  End Sub

 (半平太)

コメント返信：

[ 一覧(最新更新順) ]

[[20080728175840]] 『条件で振り分け』（みっちー） ページの最後に飛ぶ

[[20080728175840]]　『条件で振り分け』（みっちー）　ページの最後に飛ぶ