2014-11-05 2 views
0

새 시트를 만들고 주문하는 데 잘 작동하는 VBA 스크립트가 있습니다. 항목이 목록에서 제거되면 시트를 삭제하려고합니다. 어떻게이 일을 할 수 있습니까?목록에 Excel 시트가 없습니다.

Sub AddSheet() 
    Application.ScreenUpdating = False 
    Sheets("Master").Visible = True 
    Dim bottomA As Integer 
    bottomA = Range("A" & Rows.Count).End(xlUp).Row 
    Dim c As Range 
    Dim ws As Worksheet 
    For Each c In Sheets("01_Update_Employee_Lists").Range("E2:E" & bottomA) 
     Set ws = Nothing 
     On Error Resume Next 
     Set ws = Worksheets(c.Value) 
     On Error GoTo 0 
     If ws Is Nothing Then 
      Sheets("master").Select 
      Sheets("master").Copy After:=Sheets(Sheets.Count) 
      ActiveSheet.Name = c.Value 
     End If 
    Next c 
    Sheets("Master").Visible = False 
    Application.ScreenUpdating = True 

' sort worksheets in a workbook in ascending order 
Dim sCount As Integer, i As Integer, j As Integer 
    Application.ScreenUpdating = False 
    sCount = Worksheets.Count 
    If sCount = 1 Then Exit Sub 
    For i = 1 To sCount - 1 
     For j = i + 1 To sCount 
      If (Worksheets(j).Name < Worksheets(i).Name) Then 
       Worksheets(j).Move Before:=Worksheets(i) 
      End If 
     Next j 
    Next i 
End Sub 
+0

일반적으로 [게시물에 인사말이나 인사말을 사용해서는 안됩니다.] (http://meta.stackoverflow.com/questions/276033/pointless-question-edit/276037#276037). 그들은 우리의 길을 걸어 실제 질문을 이해합니다. 나는 당신을 위해 이번에 그들을 편집했습니다. –

+0

'bottomA'가'01_Update_Employee_Lists'에서 어떻게 나오고 있다고 판단합니까? 나는'ActiveSheet'에 대해 응답하지 않을 것이고'bottomA'는 정수가 아닌 long이어야합니다. – Jeeped

+0

"Sheets ("01_Update_Employee_Lists "). Range ("E2 : E "& bottomA)"를 참조하고 있습니다. – Alsjka

답변

0

대개 나는 가능한 한 On Error Resume Next을 피하려고합니다. 나는 그것이 받아 들여지는 프로그래밍 습관이라는 것을 이해한다. 그러나 나에게는 그것이 존재하지 않는다는 것을 보여주기 위해 무언가를 깨뜨리는 것은 잘못된 것이다. 어쨌든 대체로 대체 방법이 있습니다.

Sub AddSheet() 
    Application.ScreenUpdating = False 
    Sheets("Master").Visible = True 
    Dim wn As Long, ws As Long, rWSLST As Range 

    With Sheets("01_Update_Employee_Lists") 
     Set rWSLST = .Range("E2:E" & .Range("A" & Rows.Count).End(xlUp).Row) 
     For wn = 2 To .Range("A" & Rows.Count).End(xlUp).Row 
      If CBool(Len(Trim(.Cells(wn, "E").Value))) Then 
       For ws = 1 To Sheets.Count 
        If LCase(Sheets(ws).Name) = LCase(.Cells(wn, "E").Value) Then Exit For 
       Next ws 
       If ws > Sheets.Count Then 
        Sheets("master").Copy After:=Sheets(Sheets.Count) 
        Sheets(Sheets.Count).Name = .Cells(wn, "E").Value 
       End If 
      End If 
     Next wn 
     For wn = 1 To (Sheets.Count - 1) 
      For ws = wn + 1 To Sheets.Count 
       If (Sheets(ws).Name < Sheets(wn).Name) Then 
        Sheets(ws).Move Before:=Sheets(wn) 
       End If 
      Next ws 
     Next wn 
     Sheets("Master").Move Before:=Sheets(1) 
     Application.DisplayAlerts = False 
     For ws = Sheets.Count To 1 Step -1 
      If LCase(Sheets(ws).Name) <> "master" And Sheets(ws).Name <> .Name Then 
       If Not CBool(Application.CountIf(rWSLST, Sheets(ws).Name)) Then 
        Sheets(ws).Delete 
       End If 
      End If 
     Next ws 
     Application.DisplayAlerts = True 
     Set rWSLST = Nothing 
    End With 

    Sheets("Master").Visible = False 
    'Sheets("Master").Visible = xlVeryHidden 
    Application.ScreenUpdating = True 
End Sub 

나는 그것이 숨기기 워크 시트 대화 상자도 표시되지 않습니다 마스터 워크 시트 xlVeryHidden을 설정합니다 주석 처리 된 라인을 포함 시켰습니다. 둘 중 하나만 필요합니다.

+0

@Alsjka - 삭제하지 않도록 하드 코딩 된 목록에 워크 시트를 포함하도록이 코드를 수정했습니다. – Jeeped

+0

거룩한 배트맨 .. 굉장합니다! 정말 고마워요. 내 범위를 비교하기 위해 시트 이름 배열을 만드는 중이 었어. 너무 좋아 .. 너무 행복해. – Alsjka

관련 문제