[엑셀 VBA] 행높이를 복사하는 예제

■  행높이를 복사하는 예제

※ 아래 예제는 엑사모 latinum님이 만든 소스입니다. 

제가 필요에 의해서 블로그에 정리하는 차원에서 올린소스이니 착오없으시길 바랍니다. 

Option Explicit Sub dhTest()     dhRowHeightCopy Worksheets(1).Range("A1").CurrentRegion, Worksheets(2).Range("A1") End Sub Sub dhRowHeightCopy(rngOrg As Range, rngTo As Range) Dim i As Long Dim k As Long Dim objH As Object Dim dblH As Double Dim v As Variant Dim vX As Variant Dim rngTemp As Range Dim r As Long Dim j As Long     With rngOrg         If .Areas.Count >= 2 Then Exit Sub         k = .Rows.Count         Set objH = CreateObject("Scripting.Dictionary")             For i = 1 To k                 dblH = .Rows(i).RowHeight                 If objH.Exists(dblH) Then                     objH(dblH) = objH(dblH) & "," & i                 Else                     objH.Add dblH, i                 End If             Next i              End With     With rngTo         If .Rows.Count <> k Then             Set rngTo = rngTo.Resize(k)         Else         End If         k = objH.Count - 1         For i = 0 To k             vX = Split(objH.Items()(i), ",")             r = UBound(vX)             Set rngTemp = .Rows(vX(0))             For j = 1 To r                 Set rngTemp = Union(rngTemp, .Rows(vX(j)))             Next j             rngTemp.RowHeight = objH.Keys()(i)         Next i     End With Set objH = Nothing End Sub Colored by Color Scripter

cs