야옹

yaooong.egloos.com

포토로그 마이가든



시트 통합 엑셀 VBA

Option Explicit
'65536행 이상시 코드 수정해야함

Public Sub sheetsCombine()
    Dim R As Integer, sR As Integer
    Dim num As Integer
    Dim myCell As Range
    Dim mySht As Worksheet
   
    Dim wsX As Worksheet
    Dim rngD As Range
    Dim intR As Integer, intC As Integer
  
   'total 시트가 없으면 추가   
    If Worksheets(Worksheets.Count).Name <> "Total" Then
        Worksheets.Add , after:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = "Total"
    End If
   
    '기존 데이터 지우기  :65536 행 까지 지움
    Sheets("TOTAL").Select
    Range("1:65536").Select
    Selection.Delete Shift:=xlUp
   
    '첫번째 시트의 첫 행 복사해서 넣기
    Worksheets(1).Range("1:1").Copy Worksheets("TOTAL").Range("1:1")

    For Each mySht In Worksheets
    Set rngD = Range("a1").CurrentRegion
     intR = rngD.Rows.Count
     intC = rngD.Columns.Count
    R = Range("a65536").End(xlUp).Row + 1
        If mySht.Name <> "Total" Then
            With mySht
                sR = .Range("a65536").End(xlUp).Row
               .Range("2:" & sR).Copy Range(R & ":" & R)
             
            End With
        End If
    Next mySht
   
  Range("a1").Select
 
End Sub


http://examo.co.kr/tn/board.php?board=qqqNewQnA&page=2&search=시트&shwhere=subject|tbody|&command=body&no=60621

헬로써니 님 코드 수정함




트랙백

이 글과 관련된 글 쓰기 (트랙백 보내기)
TrackbackURL : http://yaooong.egloos.com/tb/1787804 [도움말]

덧글

댓글 입력 영역