日期: 2010 年 10 月 29 日

為了將一個xls檔案內的100多個sheet轉換成1個sheet，
以方便列印節省紙張，
試出來的方法~~

Sub 按鈕1_Click()
    On Error Resume Next
    Dim xlBook As Workbook
    Set xlBook = Workbooks.Open("欲轉換的來源檔.xls")

    Dim DestSh As Worksheet
    Set DestSh = ActiveWorkbook.Sheets(1)
    DestSh.Name = "匯總"

    Dim sheet As Worksheet
    Dim Last As Long
    Dim shLast As Long
    shLast = 1

    For Each sheet In xlBook.Worksheets
        Last = LastRow(sheet)
        Dim CopyRng As Range

        Set CopyRng = sheet.UsedRange

        If Last + shLast > DestSh.Rows.Count Then
            MsgBox "內容太多放不下啦!"
            Exit Sub
        End If

        CopyRng.Copy

        With DestSh.Cells(shLast + 1, 1)
            .PasteSpecial Paste:=xlPasteFormats
            '.PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteAll
            Application.CutCopyMode = xlCopy
        End With

        shLast = shLast + Last
    Next
    MsgBox "已合併完成"
End Sub

Function LastRow(sh As Worksheet)
    LastRow = sh.Cells.Find(what:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
End Function