[VBA] 시트내 각 페이지를 여러 시트로 분리

|

지식인 질문에 대한 답

"한 시트에 여러 페이지가 있는데, 각 페이지를 별개의 시트로 나누는 방법"에 대한 문의였다. 

HpageBreak가 페이지 나누기니까, 그것을 기준으로 순환문을 돌리면 된다고 간단히 생각해서, 답변을 주려고 했는데

예제 파일을 보니 시트 안에 글자만 있는 것이 아니라 도형과 차트들이 들어있었다

문제는, 도형과 차트는 시트 복사를 하면 문자처럼 자동으로 같이 따라 오는 것이 아니라

각 개체별로 따로 복사해서 위치를 조정해주어야한다는 점이었다. 


그래서 작업의 순서를 다음과 같이 잡았다


1. 페이지나누기 갯수대로 원본시트복사하기

2. 해당 각 페이지의 범위 설정 (eg. 2페이지는 15행~30행)

3. 범위에 들지 않는 페이지는 삭제 (2페이지가 아닌 1~14, 31~끝은 삭제)

4. 원본 시트에서 해당 범위에 있는 개체 찾기 (원본 시트에서 15~30행 사이에 있는 개체)

5. 해당 개체의 원본 시트에서의 위치 파악

6. 해당 개체 복사 붙여넣기

7. 개체의 위치 조정


그리고 그 결과는 아래와 같다. 

빨간색 글씨로 된 부분이 해결하기가 어려웠던 부분이다.

특히 개체를 복사해서 붙였는데, 그 붙인 개체를 선택하기 위해서는 

해당 시트를 활성화할 뿐만 아니라, 붙여넣을 셀도 활성화를 해야 비로소 붙여넣은 개체가 선택된다는 점을 알아내는데 오래걸렸다. 


그리고 늘 도형의 위치를 셀에 맞추다보니 잊고 있었는데, 도형의 실제 위치는 셀에 어중간하게 걸쳐 있을때도 있어서, 

Shape.Top이 Shape.TopLeftCell.Top과 일치하지 않을 수 있다는 것이다. 

그래서 Single 변수로 그 둘의 차이를 받아두어야 정확한 위치가 잡힌다. 

Option Explicit


Sub macro()

Dim h As HPageBreak

Dim s As Long, i As Long, ls As Long, le As Long, lsh As Long

Dim ws As Worksheet, wsS As Worksheet

Dim rng As Range, rngWss As Range

Dim sh As Shape

Dim sRngAddress As String

Dim sgDif As Single


Set wsS = ActiveSheet

Application.DisplayAlerts = False


For i = 1 To wsS.HPageBreaks.Count + 1  '페이지 수대로 시트 복사

    wsS.Copy after:=Sheets(Sheets.Count)

    Set ws = ActiveSheet

    ws.Name = i & "temp" '시트이름 임시로 부여

Next


For i = 1 To Sheets.Count - 1 '복사한 각 시트에 대해

    Set ws = Sheets(i & "temp")  '이름 설정

    With ws

        If .Name = "1temp" Then '첫행 찾기

        ls = 1

        Else

        ls = .HPageBreaks(i - 1).Location.Row

        End If

        

        If .Name = CStr(Sheets.Count - 1) & "temp" Then '끝행 찾기

        le = Rows.Count - 1

        Else

        le = .HPageBreaks(i).Location.Row

        End If

        

    Set rng = .Range(.Cells(ls, 1), .Cells(le, 1)).EntireRow '한 페이지 범위


        sRngAddress = rng.Address   '남길 페이지 범위 주소

        

        .Range(.Cells(le, 1), .Cells(Rows.Count, 1)).EntireRow.Delete  '아래쪽 지우기

        If ls > 1 Then .Range(.Cells(1, 1), .Cells(ls - 1, 1)).EntireRow.Delete        '위쪽 지우기

        

        

        For Each sh In wsS.Shapes  '원본 시트의 각 개체에 대해

            Set rngWss = wsS.Range(sRngAddress) '남길 범위의 원본 시트에서

            

            If Not Application.Intersect(rngWss, sh.TopLeftCell) Is Nothing Then '개체의 위치와 중복되면

                sh.Copy '개체 복사

                .Activate '붙여넣을 시트 활성화

                .Range("A1").Activate 'A1셀을 활성화시킨 후 붙여야 붙은 개체가 선택이 됨

                .Paste

                

                lsh = sh.TopLeftCell.Row - ls + 1 '원본 시트와 옮겨질 시트의 행 차이

                '2페이지가 15행부터 시작하고, 옮겨갈 개체가 원본에서 19행에 있다면

                '옮겨갈 시트는 1페이지이므로 개체는 새 시트에서 19- 15 + 1 인 5행에 있어야한다

                

                sgDif = sh.TopLeftCell.Top - sh.Top '개체의 행위치와 개체가 속한 셀의 위쪽 위치의 차이

                

                With Selection '선택된 개체 위치 조정

                .Top = Cells(lsh, 1).Top - sgDif

                .Left = sh.Left

                End With

            

            End If

         Next

        

    End With

    

Next


Application.DisplayAlerts = True

MsgBox "완료"


End Sub

예시파일_답.xlsm


Trackback 0 And Comment 1
  1. 먹튀 검증 2018.08.05 14:11 신고 address edit & del reply

    잘보고갑니다~

prev | 1 | 2 | 3 | 4 | ··· | 542 | next