Sub 合并当前工作簿下的所有工作表()
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set st = Worksheets.Add(before:=Sheets(1))
    st.Name = "合并"
    
    For Each shet In Worksheets
        If shet.Name <> "合并" Then
            i = st.Range("A" & Rows.Count).End(xlUp).Row + 1
            shet.UsedRange.Copy
            st.Cells(i, 1).PasteSpecial Paste:=xlPasteValues
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "已完成"
End Sub