°a¤ªºµ

¥H¤U¬O¸ÕµÛ½m²ßªºµ²ªG µ{¦¡«ÜÃlªø ½Ð¤j¤j­Ì«üÂI¤@¤U¬Ý¬Ý¦³¨S¦³¦a¤è¤£¾A¦X³o¼Ëªº¼gªk
½Ð§iª¾¤p§Ì  ½Ð°Ý¦pªG­n³]©w¦C¦L¤À­¶ªº­¶¼Æ½d³ò ¸Ó¦p¦ó¼g©O? ½Ð¤j¤j­ÌÀ°À°¦£

1. Sub ´ú¸Õ½m²ß()
   
2.     Application.ScreenUpdating = False
   
3. 
   
4.     Dim A()
   
5.     For I = 2 To Sheets.Count
   
6.         ReDim Preserve A(I - 1)
   
7.         A(I - 1) = Sheets(I).Cells(2, 2)
   
8.     Next I
   
9.    
   
10.     G = Application.Max(A)
    
11. 
    
12.     ActiveWorkbook.Save
    
13.     For k = 1 To G
    
14.         For I = 2 To Sheets.Count
    
15.             Sheets(I).Select
    
16.             If Format(Sheets(I).Cells(2, 2), "[DBNum1]0") = Format(k, "[DBNum1]0") Then
    
17.                 If Sheets(1).Cells(6, 2) = "" Then
    
18.                     Sheets(I).Range(Cells(1, 1).SpecialCells(xlCellTypeConstants), Sheets(I).Cells(1, 1).SpecialCells(xlCellTypeLastCell)).Copy Sheets(1).Cells(6, 2)
    
19.                 ElseIf Sheets(1).Cells(6, 2) <> "" Then
    
20.                     u = Sheets(1).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Offset(2, 0).Address(0, 0)
    
21.                     Sheets(I).Range(Cells(1, 1).SpecialCells(xlCellTypeConstants), Sheets(I).Cells(1, 1).SpecialCells(xlCellTypeLastCell)).Copy Sheets(1).Cells(Mid(u, 2), 2)
    
22.                 End If
    
23.             End If
    
24.         Next I
    
25.     Next k
    
26.     Sheets(1).Select
    
27.     Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlCellTypeLastCell).Offset(0, 1).Address(0, 0)).Name = "Print_Area"
    
28.    
    
29.     Application.ScreenUpdating = True
    
30. End Sub

½Æ»s¥N½X