다중영역 복사하기

Step 1: 코드 작성하기

잘 되지요? 코드를 보면…

Option Explicit
Const Msg = "범위 선택이 잘못되었습니다." & vbCr & "다시 확인하세요."
Const ID = "다중영역 복사하기//By Exceller"
 '//프로시저를 시작하기 전에 외부변수를 두 개 선언해 주었습니다.

Sub MultiRangeCopy()
    Dim intHowManyAreas As Integer
    Dim i As Integer
    Dim intNotEmpty As Integer
    Dim lngTopRow As Long
    Dim intLeftColumn As Integer
    Dim lngRowOffset As Long
    Dim intColumnOffset As Integer
    Dim rngAreas() As Range
    Dim rngTarget As Range
    Dim rngFirst As Range

    If TypeName(Selection) <> "Range" Then
        MsgBox Msg, vbInformation, ID
        Exit Sub
        '//만약 선택된 것이 Range 오브젝트가 아니면 에러 메시지를 표시하고 프로시저를 종료

    End If

    intHowManyAreas = Selection.Areas.Count
    ReDim rngAreas(1 To intHowManyAreas)
    '//몇 개의 Area가 선택되었는지를 카운팅한 다음, ReDimension 문을 사용해서 배열의 크기를
    '//재지정합니다.

    For i = 1 To intHowManyAreas
        Set rngAreas(i) = Selection.Areas(i)
    Next
    '//각 영역을 rngAreas 배열변수의 각 요소에 저장을 하지요.

    lngTopRow = ActiveSheet.Rows.Count
    intLeftColumn = ActiveSheet.Columns.Count

    For i = 1 To intHowManyAreas
        With rngAreas(i)
            If .Row < lngTopRow Then lngTopRow = .Row
            If .Column < intLeftColumn Then intLeftColumn = .Column
        End With
    Next i
    Set rngFirst = Cells(lngTopRow, intLeftColumn)

    On Error Resume Next
    Set rngTarget = Application.InputBox("붙여넣을 좌측 상단 셀 선택:", Type:=8)
    On Error GoTo 0
    If TypeName(rngTarget) <> "Range" Then
        MsgBox Msg, vbInformation, ID
        Exit Sub
    '//복사할 위치값을 InputBox를 통해 입력을 받되 입력된 값이 유효하지 않을 경우에 대한
    '//처리를 하기 위한 구문입니다.

    End If
    Set rngTarget = rngTarget.Cells(1)

    For i = 1 To intHowManyAreas
        lngRowOffset = rngAreas(i).Row - lngTopRow
        '//lngTopRow에는 항상 복사할 영역 내의 첫번째 셀의 행번호가 Assign됩니다. 그래야
        '//기준셀(즉 첫번째 셀을 기준으로 하여 일정한 거리만큼 Offset을 할 수 있겠지요?
        '//잘 이해가 안가는 분은 큰 종이 위에 좌표를 하나씩 대입해가며 파악을 해 보세요.

        intColumnOffset = rngAreas(i).Column - intLeftColumn
        '//intLeftColumn에는 항상 복사할 영역 내의 첫번째 셀의 열번호가 Assign 됩니다.

        intNotEmpty = intNotEmpty + Application.CountA(Range(rngTarget.Offset(lngRowOffset, _
            intColumnOffset), rngTarget.Offset(lngRowOffset + rngAreas(i).Rows.Count - 1, _
            intColumnOffset + rngAreas(i).Columns.Count - 1)))
    Next i

    If intNotEmpty <> 0 Then If MsgBox("기존 데이터에 겹쳐 쓸까요?", vbQuestion + vbYesNo, _
        "여러 범위 복사하기") <> vbYes Then Exit Sub
    '//붙여 넣을 범위가 비어 있지 않으면 경고를 합니다.

    For i = 1 To intHowManyAreas
        lngRowOffset = rngAreas(i).Row - lngTopRow
        intColumnOffset = rngAreas(i).Column - intLeftColumn
        rngAreas(i).Copy rngTarget.Offset(lngRowOffset, intColumnOffset)
        '//복사할 첫번째 셀의 위치를 기준으로 행/열 이동값을 산출하기 위한 과정입니다.
    Next i
End Sub

마무리

오늘 설명드린 내용은 코드 자체는 그다지 길지 않습니다만 약간 생각을 해보아야 이해가 가실 것입니다. 빈 종이 위에다 좌표를 몇 번 그려가면서 따라해 보시면 이해하실 수 있으리라 생각됩니다.

직원 집들이에 갔다가 음주가무… 까지는 아니고 음주만 좀 했더니 머리가 맑지를 않군요. 그래서 자세한 설명은 드리지 못한 듯 합니다. 하지만,

No Pains, No Gains!
Easy Come, Easy Go!!!

이라는 사실을 명심하시고 열심히 따라오시기 바랍니다.

다음에 또…

정리 — 다중영역 복사 핵심

자주 묻는 질문 (FAQ)

마치며

좌표를 따져 가며 오프셋을 계산하면 기본 기능으로 안 되는 다중영역 복사도 구현할 수 있습니다.