표 간 서식 복사하기

1. 문제

아래와 같이 표 2개가 있고, 위의 서식이 변하면 아래에 서식이 자동으로 복사되도록 하려고 합니다.

서식 복사(문제).xlsx

0.01MB

 

2. 해법 1(실패)

일단 생각할 수 있는 것이 Worksheet_Change 메서드입니다.

Sheet1을 클릭한 다음 오른쪽 코드 창에서 Worksheet 객체를 선택한 다음 오른쪽에서 Change 메서드를 클릭합니다.

 

그러면 아래와 같이 Worksheet_Change 서브 프러시저가 생성됩니다.

 

"일정한 범위 내 값이 바뀐다면"이라는 조건문은
아래와 같이 정형화되어 있습니다.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim keyCells As Range
    
    Set keyCells = Range("c5:d8")
    
    If Not Application.Intersect(keyCells, Target) Is Nothing Then
        MsgBox "셀 값이 변경되었습니다."
    End If
End Sub

 

keyCells가 값이 변하는지 체크할 범위이고,

If Not Application.Intersect(keyCells, Target) Is Nothing이 교차점이 없는 것(nothing)이 아니라면(not)이 돼서 "값이 변한다면"이 됩니다.

 

C6셀의 1300을 1400으로 바꾸면 아래와 같이 "셀 값이 변경되었습니다"라는 메시지가 나옵니다.

 

그렇다면 값이 바뀔 경우 해당 서식을 아이템명이 일치하는 줄의 해당 날짜에 적용하면 됩니다.

MsgBox 해당 줄은 지워버리고,

교차하는 셀인 Target셀을 Copy(복사) 한 후

    If Not Application.Intersect(keyCells, Target) Is Nothing Then
        Target.Copy
        
        Dim c As Range
        Dim pasteArea As Range
    
        With Worksheets(1).Range("A14:A17")
            Set c = .Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Set pasteArea = Cells(c.Row, Target.Column)
                pasteArea.PasteSpecial xlPasteFormats
            End If
        End With
    End If

 

열은 동일하므로 두 번째 표에서 아이템명이 일치하는 것을 찾아야 하므로

아이템 범위인 Worksheets(1).Range("A14:A17")를 가지고(With) 처리하는데,

 

Set c = .Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)는 A열 Target 행의 값인 LR600(LHS)를 찾는데, 부분일치되는 것이 있으므로 xlWhole로 전체가 일치하는 것을 찾습니다.

 

If Not c Is Nothing Then란 "찾는 값이 없는 것이 아닌"이므로 찾는 값이 있을 때가 되고,

Set pasteArea = Cells(c.Row, Target.Column)는 붙여 넣을 범위를 찾은 행에 Target의 열을 결합한 셀인 C16셀을 pasteArea 변수에 저장합니다.

 

pasteArea.PasteSpecial xlPasteFormats는 pasteArea에 서식으로 붙여 넣는다는 의미입니다.

 

두 번째 표의 C16셀과 D16셀의 서식을 제거한 다음 C6셀의 값을 1300으로 다시 바꾸면
C16셀의 서식, 다시 말해 채우기가 됐습니다.

 

그런데, 문제는 C6셀의 서식을 복사한 후

 

D6셀에 붙여 넣으면 D16셀의 값도 바뀌는데,

 

D6셀의 채우기 색을 노란색으로 바뀌면 아무런 변화가 없다는 것입니다.

 

3. 해법 2(성공)

가. 발상의 전환

채우기 색이 바뀌는 경우에도 모두 적용되도록 하려면

다행히 C16셀에 =$C$6이라고 되어 있으므로

 

C16셀의 수식에서 C6셀의 수식을 복사한 후 C16셀에 붙여 넣으면 됩니다.

D16셀의 수식도 =D6이라고 되어 있습니다.

 

나. 코드

Sub copyFormat()
    Dim pasteArea As Range, secondData As Range
    Dim c As Range, d As Range
    
    '서식을 적용할 범위 지정
    Set pasteArea = Application.InputBox("서식을 지정할 범위를 마우스로 끌어서 지정하세요.", Type:=8)
    
    '서식을 적용할 범위내 셀을 돌아가면서 실행
    For Each c In pasteArea
        
        '수식이 있고, 값과 수식이 다를 때만 서식 복사
        If Len(c.Formula) > 0 And c.Value <> Val(c.Formula) Then
            '수식의셀 주소를 복사한 후
            Range(Mid(c.Formula, 2)).Copy
            
            '서식을 적용할 셀에 서식만 붙여 넣음
            c.PasteSpecial xlPasteFormats
            
        End If
    Next
End Sub

 

Set pasteArea = Application.InputBox("서식을 지정할 범위를 마우스로 끌어서 지정하세요.", Type:=8) => Application.InputBox는 입력을 받는 대화 상자로 Type이 8이면 범위로 받아서, pasteArea 변수에 저장합니다.

 

For Each c In pasteArea : 위에서 입력받은 서식을 지정할 범위 내 셀을 이동하면서 반복 처리합니다.

 

Range(Mid(c.Formula, 2)).Copy : 수식이 =$C$6식으로 =이 있으므로 두 번째부터 모두를 선택한 후 범위로 바꾼 후 복사합니다. 다시 말해 수식에서 참조하는 셀을 복사하는 것입니다.

 

c.PasteSpecial xlPasteFormats : 서식을 지정할 범위 내 셀인 c에 선택하여 붙여 넣기를 하는데, 서식으로 하는 것입니다. 다시 말해 서식만 붙여 넣는 것입니다.

 

버튼을 만든 후 매크로를 지정했다면, 버튼을 누르면

 

서식을 지정할 범위를 선택하라고 하는데 C13셀에서 D17셀까지 지정하고 엔터 키를 누릅니다.

그러면 위 노란색 채우기를 복사한 후 아래에 서식으로 붙여 넣습니다.

 

서식 복사(완성).xlsm

0.02MB