|
|
|
| |
|
|
| |
Sub make_sheet_by_name()
'-------------------------------
Dim rng As Range
Dim rngRow As Range
Dim sht As Worksheet
Dim newsht As Worksheet
Dim oList As Object: Set oList = CreateObject("System.Collections.ArrayList")
Application.ScreenUpdating = False
'기존시트 삭제
Application.DisplayAlerts = False
For Each sht In Worksheets
If sht.Name <> "현황" Then sht.Delete
Next
Application.DisplayAlerts = True
'데이타 범위
Set rng = Sheet1.Range("A3").CurrentRegion
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Dim rngC As Range
Dim vCell As String
For Each rngRow In rng.Rows
'이름 셀
Set rngC = rngRow.Cells(2)
'이름 값
vCell = rngC.Value
If shtExist(vCell) Then '시트가 존재하면
'현재행을 복사(시트의 데이타가 있는 마지막 행 다음 행에 복사)
rngRow.Copy Worksheets(vCell).Range("A3").End(xlDown).Offset(1)
Else '시트가 존재하지 않으면
'ArrayList에 추가
oList.Add vCell
'새로운 시트 생성
Set newsht = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'시트 이름
newsht.Name = vCell
'타이틀 및 제목행 복사
Sheet1.Range("a1:E3").Copy newsht.Range("a1")
'현재 행 복사
rngRow.Copy newsht.Range("A4")
End If
Next
'sheet소트
oList.Sort
'ArrayList 요소를 거꾸로
oList.Reverse
'ArrayList를 배열로 만듦
Dim vSheet As Variant: vSheet = oList.toarray
'시트 정렬
For Each sSheet In vSheet
Worksheets(sSheet).Move After:=Worksheets(Worksheets.Count)
Next
'현황 시트를 제일 처음으로 이동
Worksheets("현황").Move Before:=Worksheets(1)
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------
Function shtExist(sSheet As String) As Boolean
'---------------------------------------------------
Dim shtX As Worksheet
On Error Resume Next
Set shtX = ThisWorkbook.Worksheets(sSheet)
If Err.Number <> 0 Then '시트가 존재하지 않음
shtExist = False
Else
shtExist = True
End If
On Error GoTo 0
End Function |
|
|
[불량 게시물 신고] |
|
|
|
|
작성일 : 2019-05-31(20:24)
최종수정일 : 2019-05-31(20:24) |
| |
    |
 
  |
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
