常用功能加載宏——多個工作表合并到一個工作表

把資料複制到一個工作簿後，一般我們還需要進行資料處理，而資料處理要在一個工作表才友善，是以把多個工作表的資料複制到一個工作表再進行資料處理也會經常碰到：

首先在customUI.xml中增加代碼：

<button id="rbbtnMergeSht" label="合并工作表" onAction="rbbtnMergeSht" imageMso="TableInsert" />           

複制

回調函數：

Sub rbbtnMergeSht(control As IRibbonControl)
    Call MShtWk.MergeSht
End Sub           

複制

函數實作：

Sub MergeSht()
    Dim rngout As Range
    
    On Error Resume Next
    Set rngout = Application.InputBox("請選擇輸出單元格，輸出單元格所在Sheet将不會被複制，但資料會覆寫。", Default:=ActiveCell.Address, Type:=8)
    On Error GoTo 0
    
    If rngout Is Nothing Then
        Exit Sub
    End If
    
    Dim flagHead As Boolean '記錄是否複制了标題
    Dim rows As Long
    Dim cols As Long
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.Name <> rngout.Parent.Name Then         
            With sht
                '取消篩選
                .AutoFilterMode = False
                '按第一列定位，擷取表格的最後所在的行   
                rows = .Cells(Cells.rows.Count, 1).End(xlUp).Row
                If rows > 1 Then
                    '擷取表格的列的範圍
                    cols = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
                    
                    '複制标題
                    If Not flagHead Then
                        .Range("A1").Resize(1, cols).Copy rngout
                        rngout.Offset(0, cols).Resize(1, 1).Value = "SheetName"
                        Set rngout = rngout.Offset(1, 0)
                        flagHead = True
                    End If
                    
                    '複制資料
                    .Range("A2").Resize(rows - 1, cols).Copy rngout
                    
                    '如果隻需要複制數值：
'                    .Range("A2").Resize(rows - 1, cols).Copy
'                    rngout.PasteSpecial xlPasteValues

                    '如果需要，可以增加一列Sheet名稱
                    rngout.Offset(0, cols).Resize(rows - 1, 1).Value = .Name
                    
                    '輸出單元格進行偏移
                    Set rngout = rngout.Offset(rows - 1, 0)
                End If
            End With
        End If
    Next
    
End Sub           

複制