tipsやちょっとしたスクリプト

'このスクリプトはパブリックドメイン またはMITライセンスの何れかでライセンス
'されます。
Sub MovSheet()
    r = 2
    Do While Cells(r, 1).Value <> ""
    ActiveWorkbook.Sheets(r).Name = " " & r
    
    r = r + 1
    Loop
    
    r = r - 1
    Do While r > 1
        If Cells(r, 2).Value = "" Then
            ActiveWorkbook.Sheets(r).Name = Cells(r, 1)
        ElseIf Cells(r, 3).Value = "" Then
                    ActiveWorkbook.Sheets(r).Name = Cells(r, 2)
        ElseIf Cells(r, 4).Value = "" Then
            Set wb = ActiveWorkbook
            sn = Cells(r, 2)
            ActiveWorkbook.Sheets(r).Name = sn
            ActiveWorkbook.Sheets(r).Copy _
                before:=Workbooks(Cells(r, 3).Value).Worksheets(1)
            wb.Activate
        ElseIf Cells(r, 4).Value = "MOVE" Then
            Set wb = ActiveWorkbook
            sn = Cells(r, 2)
            ActiveWorkbook.Sheets(r).Name = sn
            ActiveWorkbook.Sheets(r).Move _
                before:=Workbooks(Cells(r, 3).Value).Worksheets(1)
            wb.Activate
        End If
            
        r = r - 1
        ActiveWorkbook.Sheets(1).Select
    Loop
End Sub

トップ   差分 バックアップ リロード   一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2013-08-18 (日) 17:36:49 (3910d)