[VBA]Merge풀고값자동채우기

Option Explicit
Sub unMerge_and_Fill()
Dim rngC As Range '선택영역 각 셀을 넣을 변수
Dim r As Long '카운터로 사용할 변수

Application.ScreenUpdating = False '화면 업데이트 중지

With Selection
If .Cells.Count = 1 Then '한 셀만 선택 시 매크로 중지
MsgBox "한 셀만 선택함. 영역 재설정 후 실행", 64, "영역설정 오류"
Exit Sub '매크로 중단
End If
End With

For Each rngC In Selection '선택 영역을 순환
If rngC.MergeCells Then '만일 선택셀이 셀병합 되어 있다면
With rngC.MergeArea '셀병합된 area를
.UnMerge '셀병합을 풀고
.Value = rngC '셀병합 풀린영역 셀병합전 값으로 채움
End With
r = r + 1 '카운터를 1씩 늘려감
End If
Next

If r > 0 Then
MsgBox "전체 " & r & "개의 셀병합된 셀을 풀고 복사했음"
Else
MsgBox "선택 영역내에 병합된 셀이 없음.", vbInformation, "병합된셀 없음"
Exit Sub
End If

End Sub
[출처] (87) 셀병합 해제하고 같은 값으로 채우기 (엑셀 VBA 매크로)|작성자 니꾸