飘云阁(PYG官方)

 找回密码
 快速注册

QQ登录

只需一步,快速开始

查看: 123|回复: 1

[求助] 大神们求教一下,这个拆分表,最后一页不能拆分显示全,怎么调代码比较好

[复制链接]
  • TA的每日心情
    开心
    前天 09:30
  • 签到天数: 49 天

    [LV.5]常住居民I

    发表于 2020-9-23 10:54:20 | 显示全部楼层 |阅读模式
    本帖最后由 qwsss31 于 2020-9-23 10:56 编辑

    大神们求教一下,这个拆分表,最后一页不能拆分显示全,怎么调代码比较好。
    不论多少页,拆分的最后一页总是缺少。

    Sub AutoXXPage()
        Dim sht As Worksheet
        Dim shtT As Worksheet
        Set sht = Worksheets("Sheet1")
        Dim HP As HPageBreak
        Dim strSRow As Long, strERow As Long
        Dim n As Long
        strSRow = "1"
        For Each HP In sht.HPageBreaks
            strERow = CStr(HP.Location.Row - 1)
            n = n + 1
            Set shtT = ThisWorkbook.Worksheets.Add
            shtT.Name = "第" & CStr(n) & "页"
            sht.Range(strSRow & ":" & strERow).Copy
            shtT.Paste
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                                   SkipBlanks:=False, Transpose:=False
            strSRow = CStr(HP.Location.Row)
        Next
        n = n + 1
        Set shtT = ThisWorkbook.Worksheets.Add
        shtT.Name = "第" & CStr(n) & "页"
        sht.Range(strSRow & ":" & CStr(sht.Range("g65536").End(xlUp).Row)).Copy
        shtT.Paste
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                               SkipBlanks:=False, Transpose:=False
        sht.Activate
        Set sht = Nothing
        Set shtT = Nothing
    End Sub


    您需要登录后才可以回帖 登录 | 快速注册

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    小黑屋|手机版|Archiver|飘云阁安全论坛 ( 粤ICP备15107817号-2 )|扫码赞助

    Powered by Discuz! X3.3© 2001-2017 Comsenz Inc.

      
    快速回复 返回顶部 返回列表