GBKEE

¦^´_ 4# simplehope
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sh As Worksheet, xCol As Integer, Rng As Range, i As Integer
   
4.     For Each Sh In ActiveWorkbook.Sheets
   
5.          If Sh.PageSetup.PrintArea <> "" Then
   
6.             Set Rng = Nothing
   
7.             With Sh
   
8.                 xCol = .VPageBreaks(1).Location.Column
   
9.                 For i = 1 To .HPageBreaks.Count
   
10.                     If .HPageBreaks(i).Location.Range("F16") = "" Then Set Rng = .HPageBreaks(i).Location: Exit For
    
11.                 Next
    
12.                 If Not Rng Is Nothing Then
    
13.                     .PageSetup.PrintArea = .Range("a1", .Cells(Rng.Offset(-1).Row, xCol)).Address
    
14.                     .Range("a1", .Cells(Rng.Offset(-1).Row, xCol)).Select
    
15.                     .Range(Rng, .Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row)).Resize(, xCol).Delete xlUp
    
16.                     'AJÄæ­ì¥»¤½¦¡=IF(AT14="","",$AT$74) , §ï¤½¦¡ =Á`­¶¼Æ
    
17.                 End If
    
18.             End With
    
19.             Sh.Names.Add Name:="Á`­¶¼Æ", RefersToR1C1:=Sh.HPageBreaks.Count + 1
    
20.         End If
    
21.     Next
    
22. End Sub

½Æ»s¥N½X

PS:2016/10/08 ­×¥¿

GBKEE

¦^´_ 7# simplehope

5# ªºµ{¦¡½X¤w­×¥¿,½Ð¦A¸Õ¸Õ

'** ¨úA1¨ì ²Ä¤@­Ó««ª½¤À­¶½uªº³Ì¥kÃ䪺Äæ¦ì)¦A¦V¤U¨ì¤u§@­¶ªº ³Ì«á¤@­ÓÀx¦s®æªº¦C¸¹******
Range(Rng, .Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row)).Resize(, xCol).Delete xlUp
'AJÄæ­ì¥»¤½¦¡=IF(AT14="","",$AT$74) , §ï¤½¦¡ =Á`­¶¼Æ
'SpecialCells : expression.SpecialCells(Type, Value)
'SpecialCells ¤èªk    ¶Ç¦^ Range ª«¥ó¡A¦¹ª«¥ó¥Nªí»P«ü©w«¬ºA¤Î­È¬Û²Å¦Xªº©Ò¦³Àx¦s®æ¡CRange ª«¥ó
'Type     ¥²¿ïªº XlCellType¡C­n¥]§tªºÀx¦s®æ¡C
'xlCellTypeLastCell¡C¤w¥Î½d³òªº³Ì«á¤@­ÓÀx¦s®æ=>¤u§@­¶ªº ³Ì«á¤@­ÓÀx¦s®æ

ÁÙ¦³³o¥y¬O
Sh.Names.Add Name:="Á`­¶¼Æ", RefersToR1C1:=Sh.HPageBreaks.Count + 1
**·s¼W¤@­Ó¦WºÙ½d³ò¥s "Á`­¶¼Æ"¡A¨úR1C1®æ¦¡¡A¬Ý¦³´X­ÓHPageBreak ¦A+ 1 **
¨ºAJÄæ­n«ç»ò³s¨ì"Á`­¶¼Æ"©O?
**** ¤£¬O¦³½Ð§A ¦bAJÄæ­ì¥»¤½¦¡=IF(AT14="","",$AT$74) , §ï¤½¦¡ =Á`­¶¼Æ****

GBKEE

¦^´_ 9# simplehope
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub ¶×¥X¦a½S¸ê®Æ¨ì·s¤u§@ªí()
   
3.     Dim Sh(1 To 2), Rng(1 To 2) As Range, xCol As Integer, R As Integer
   
4.     Application.ScreenUpdating = False
   
5.     Set Sh(1) = Sheets("Mom (38P) (2)")    '**¨¾¤î¥X¿ù: «ü©w¤u§@ªí¦WºÙ***
   
6.     'Set Sh(1) = ActiveSheet ''§ì¥Ø«e¤u§@ªí¦WºÙ
   
7.     '¨¾§b1
   
8.     For Each Sh(2) In Sheets
   
9.         If InStr(Sh(2).Name, "¶×¥X") Then
   
10.             Application.DisplayAlerts = False
    
11.             Sh(2).Delete
    
12.             Application.DisplayAlerts = True
    
13.             Exit For
    
14.         End If
    
15.     Next
    
16.     With Sheets.Add(, Sheets(Sheets.Count))
    
17.         .Name = Sh(1).Name & "¶×¥X"
    
18.         Set Sh(2) = ActiveSheet
    
19.     End With
    
20.     Sh(1).Select
    
21.     Sh(1).Range("A1:AM15").Copy
    
22.     MyCopy Sh(2).Range("A1")
    
23.     With Sh(1)
    
24.         xCol = .VPageBreaks(1).Location.Column - 1
    
25.         For i = 0 To .HPageBreaks.Count
    
26.             If i = 0 Then
    
27.                 Set Rng(1) = .Range("A16")
    
28.             Else
    
29.                 Set Rng(1) = .HPageBreaks(i).Location.Range("A16")
    
30.             End If
    
31.             If Rng(1).Cells(1, 6) <> "" Then
    
32.                 With Rng(1)
    
33.                     R = .Cells(1, 6).End(xlDown).Row - .Row
    
34.                     If R < 25 Then R = R + 1
    
35.                     Rng(1).Resize(R, xCol).Copy
    
36.                 End With
    
37.                 With Sh(2).Range("A" & Rows.Count).End(xlUp)(2)      ' (2)= .Offset(1) = .Cells(2)
    
38.                     If .Row < 16 Then        'A13:A15 ¬°¦X¨ÖÀx¦s®æ : .Offset(1)-> = A14
    
39.                         Set Rng(2) = .Parent.Range("A16")
    
40.                     Else
    
41.                         Set Rng(2) = .Cells
    
42.                     End If
    
43.                 End With
    
44.                 MyCopy Rng(2)
    
45.             Else
    
46.                 Exit For
    
47.             End If
    
48.         Next
    
49.     End With
    
50.     Application.ScreenUpdating = True
    
51.     MsgBox ("¶×¥X§¹¦¨")
    
52. End Sub
    
53. Sub MyCopy(Rng As Range)   'µ{¦¡(¶Ç»¼°Ñ¼Æ)  : ¬Û¦Pªºµ{¦¡½X¥i¥Î
    
54.     With Rng
    
55.         .PasteSpecial Paste:=xlPasteValues              '­È
    
56.         .PasteSpecial Paste:=xlPasteColumnWidths 'Äæ¼e
    
57.         .PasteSpecial Paste:=xlPasteFormats            '®æ¦¡
    
58.     End With
    
59. End Sub

½Æ»s¥N½X