Do While~Loop (1)
엑셀 VBA #88 / 시트통합_VBA필수 [VBA]
반응형

엑셀 VBA #88 / 시트통합_VBA필수 [VBA]

 

Sub MergeData_By_For_Next()
      Dim i As Long
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      For i = 2 To 4
      'sheet2번부터 4번까지(1월~3월시트)//// 4를 'Worksheets.Count'로 하는 게 High Class
            Sheets(i).Range("a1").CurrentRegion.Copy _
            Sheet1.Cells(Rows.Count, "a").End(xlUp).Offset(1)
            '~~~~~~End(xlUp).Offset(1) => ~~~~~End(3)(2)
      Next
      
      Application.ScreenUpdating = True
End Sub

Sub MergeData_By_For_Each_Next()

      Dim sh As Worksheet
      Dim i As Long
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      i = 2
      For Each sh In ThisWorkbook.Worksheets
            'if sh.name<>activesheet.name then
            If sh.Name <> Sheet1.Name Then   
            'If sh<>Sheet1 Then하면 에러인데...왜?
                  Sheets(i).Range("a1").CurrentRegion.Copy _
                  Sheet1.Cells(Rows.Count, "a").End(xlUp).Offset(1)
                  i = i + 1
            End If
      Next

      Application.ScreenUpdating = True
      
End Sub

Sub MergeData_By_Do_Loop()

      Dim cnt As Long, i As Long
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      cnt = Worksheets.Count
      
      i = 2
      
      Do While i <= cnt
        Sheets(i).Range("a1").CurrentRegion.Copy _
        Sheet1.Cells(Rows.Count, "a").End(xlUp).Offset(1)
        i = i + 1
      Loop
      Application.ScreenUpdating = True
End Sub

Sub MergeData_By_For_Next실무형()
      Dim i As Long
      Dim rng As Range
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      Sheet1.Range("a1:f1") = Array("월", "필드1", "필드2", "필드3", "필드4", "필드5")
      For i = 2 To Worksheets.Count
            Sheets(i).Range("a1").CurrentRegion.Copy _
            Sheet1.Cells(Rows.Count, "B").End(xlUp).Offset(1)
            
            Set rng = Sheet1.Range("a1").CurrentRegion
            rng.SpecialCells(xlCellTypeBlanks) = Sheets(i).Name
      Next
      Application.ScreenUpdating = True
End Sub

 

 

vba#88.xlsm
0.03MB

 



https://www.youtube.com/watch?v=lo7x3cG7rLI&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=89


 

 

 

반응형
  Comments,     Trackbacks
최근 작성 글
최근 작성 댓글
최근 작성 트랙백
프로필
공지사항
글 보관함
캘린더
«   2024/12   »
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31
TODAY TOTAL