Option Explicit
Sub match_RowHeight_ColumnWidth()

'니꾸님 블로그 참고하여 소스 수정 (http://blog.naver.com/PostView.nhn?blogId=rosa0189&logNo=60156660570)


    Dim wkBk1 As Workbook                         '매크로 실행전 활성화된 파일 넣을 변수
    Dim rngC As Range                                '사용영역 1열의 각 셀을 넣을 변수
    Dim r As Long                                        '배열값을 1씩 늘려갈 변수
    Dim varTemp()                                       '각 행의 높이를 넣을 동적 배열변수
    Dim rngSel As Range                              '입력창에서 선택한 영역을 넣을 변수
    Dim fileName As String                            '복사될 타겟 파일의 파일이름을 넣을 변수
    Dim shtName As String                            '복사될 타겟 파일의 시트이름을 넣을 변수
    Dim strAddr As String                              '복사될 타겟 파일의 선택된셀 주소를 넣을 변수
  
    Dim WS_Count As Integer     '//워크시트 숫자 넣을 변수
    Dim I As Integer
         
    WS_Count = ActiveWorkbook.Worksheets.Count      ' //워크시트 갯수를 변수에 입력

    
    
    Set wkBk1 = ActiveWorkbook                    '활성화된 셀을 변수에 넣음
    With ActiveSheet.UsedRange                    '현재시트 사용영역에서
 
        For Each rngC In .Resize(, 1)               '1열의 각셀을 순환
            r = r + 1                                          '행을 1씩 늘려감
            ReDim Preserve varTemp(1 To r)       '배열크기 재지정
            varTemp(r) = rngC.RowHeight           '각 셀의 행 높이를 배열에 넣음
        Next rngC
        
        On Error Resume Next                           '에러 발생해도 다음코드 진행
   
        
         End With
        
        
        
                        
        For I = 2 To WS_Count           ' // 첫번째 시트가 복사할 원본이므로 I=2부터
        
        
        Set rngSel = ActiveWorkbook.Worksheets(I).Range("A1")
        
         If rngSel Is Nothing Then Exit Sub          '취소 선택시 매크로 중단
        On Error GoTo 0                                   '에러검출기능 복원
    
        Application.ScreenUpdating = False        '화면 업데이트 (일시)정지
            
        fileName = rngSel.Parent.Parent.Name     '선택된 셀이 속한 파일이름을 변수에 넣음
        shtName = rngSel.Parent.Name               '선택된 셀이 속한 시트이름을 변수에 넣음
       
       ' strAddr = .Cells(1).Address                    '첫 번째 셀의 주소를 변수에 넣음
       ' .Resize(1).Copy                                   '첫 행을 복사
        
        strAddr = ActiveSheet.UsedRange.Cells(1).Address        '//첫행 주소를 변수에 넣고 복사
        ActiveSheet.UsedRange.Resize(1).Copy
        
        
        
 
    
    Workbooks(fileName).Activate                     '복사될 타겟 파일 활성화
    Worksheets(shtName).Activate                    '복사될 타겟 시트 활성화
    Range(strAddr).Activate                             '복사될 시트 활성화
    ActiveSheet.PasteSpecial xlPasteColumnWidths  '열 너비를 복사
    
    r = 0                                                         '재사용 위하여 0으로 초기화
    For Each rngC In Range(strAddr).Resize(UBound(varTemp)) '복사될 시트의 1열 각셀을 순환
        r = r + 1                                                '배열값을 1씩 늘려감
        rngC.RowHeight = varTemp(r)                 '각 셀의 행 높이를 배열에 있는 값으로 바꿈
    Next rngC
    
    
    Next I
    
    Application.CutCopyMode = False               '복사모드 해제 (클립보드 비우기)
    
    Set wkBk1 = Nothing                                  '개체변수들 초기화 (메모리 비우기)
    Set rngSel = Nothing
End Sub