两种方法导出工作表

Sub ExportSheet()
'
' Macro1 Macro
' 宏由 红色金刚石 录制，时间: 2015-3-14
'
    On Error Resume Next
    
    Dim e_path As String
    e_path = ThisWorkbook.path & "\" & "Export_" & CStr(Year(Date)) ' & "_" & Month(Date)
    
    thePathIsExistsAndMkit e_path
    
    Dim ffilter, initfname, str_path As String
    Dim fname As String
    fname = ""
    ffilter = "EXCEL97/2000/2003文件 (*.xls), *.xls|文本文件  (*.txt), *.txt|所有文件 (*.*), *.*"
    
    str_path = Left(ThisWorkbook.name, InStr(ThisWorkbook.name, ".") - 1)
    str_path = str_path & "_" & InitView.GetCurDwmc
    str_path = str_path & "_" & CStr(Date)
    
    initfname = e_path & "\" & str_path

    fname = Application.GetSaveAsFilename( _
        fileFilter:=ffilter, _
        InitialFileName:=initfname)
    
    If Not Trim(fname) = "" And Not Trim(fname) = "False" Then
    
        Sheets("明细表").Select
        Sheets("明细表").Copy
    
        For Each s In Sheets
          s.UsedRange = s.UsedRange.value
        Next
    
        ChDir "."
        
        ActiveWorkbook.SaveAs Filename:=fname, FileFormat:= _
            xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
            , CreateBackup:=False
       
        ActiveWorkbook.Close 1
    Else
        MsgBox "未能导出文件或用户取消操作！", vbInformation, "提示"
    End If
    
End Sub

Public Sub thePathIsExistsAndMkit(pathName As String)

'如果子目录不存在，则建立之

    Dim mypathtofind As Object
    
    Set mypathtofind = CreateObject("Scripting.FileSystemObject")
    
    If Not mypathtofind.folderExists(pathName) Then
        
        mypathtofind.createfolder (pathName)
        
    End If

End Sub


Sub ExportSheet2()
'
' Macro1 Macro
' 宏由 红色金刚石 录制，时间: 2015-3-14
'
    On Error Resume Next
    
    Dim e_path As String
    e_path = ThisWorkbook.path & "\" & "Export_" & CStr(Year(Date)) ' & "_" & Month(Date)
    
    thePathIsExistsAndMkit e_path
    
    Dim ffilter, initfname, str_path As String
    Dim fname As String
    fname = ""
    ffilter = "EXCEL97/2000/2003文件 (*.xls), *.xls|文本文件  (*.txt), *.txt|所有文件 (*.*), *.*"
    
    str_path = Left(ThisWorkbook.name, InStr(ThisWorkbook.name, ".") - 1)
    str_path = str_path & "_" & InitView.GetCurDwmc
    str_path = str_path & "_" & CStr(Date)
    
    initfname = e_path & "\" & str_path

    fname = Application.GetSaveAsFilename( _
        fileFilter:=ffilter, _
        InitialFileName:=initfname)
    
    If Not Trim(fname) = "" And Not Trim(fname) = "False" Then
        
        Dim wb As Workbook
        Set wb = Workbooks.Add(ThisWorkbook.path & "\template\templatedetaile.xls")
        
        Dim s_t_title, s_t_fz, s_t_bbdw, s_t_bbsj As String
        s_t_title = PublicProperty.当前工作年月 & PublicProperty.Sydwmc & "护士奖金发放明细表"
        Dim dwlist() As String
        dwlist = SheetsSet.xtdwlist
        Dim k
        For k = 0 To UBound(dwlist, 1)
            If PublicProperty.当前计算单位 = dwlist(1, k + 1) Then
                s_t_fz = IIf(k > 0, "之" & Application.Text(k, "[DBnum1]"), "")
            End If
        Next
        s_t_title = s_t_title & s_t_fz
        s_t_bbdw = PublicProperty.Sydwmc
        s_t_bbsj = Format(Date, "yyyy年mm月dd日")
        With wb
            .ActiveSheet.Cells(1, 1).value = s_t_title
            .ActiveSheet.Cells(2, 4).value = s_t_bbdw
            .ActiveSheet.Cells(2, 23).value = s_t_bbsj
            Dim i_f, i_e
            i_f = ThisWorkbook.RngFind("序号", Range("a1:y100")).row
            i_e = ThisWorkbook.RngFind("合计", Range("a1:y100")).row
            Dim 表格行数
            表格行数 = i_e - i_f - 3
            Dim a_jjsj() As String
            a_jjsj = filteData(ImportFfData)
            Dim i, j
            If 表格行数 < UBound(a_jjsj, 2) Then
                Dim zjh
                zjh = UBound(a_jjsj, 2) - 表格行数
                For i = 0 To zjh + PublicProperty.显示空行数
                    Rows("" & i_e + i - 1 & ":" & i_e + i - 1).Select
                    Selection.Insert Shift:=xlDown
                Next
            End If
            
            Dim s_dw As String
            s_dw = PublicProperty.当前计算单位

            For i = 0 To UBound(a_jjsj, 2)
                    For j = 1 To UBound(a_jjsj, 1) - 1
                        .ActiveSheet.Cells(i + i_f + 3, j + 1).value = a_jjsj(j, i)
                    Next
                .ActiveSheet.Cells(i + i_f + 3, 1).value = i + 1
            Next
        End With
        
         ActiveWorkbook.SaveAs Filename:=fname, FileFormat:= _
             xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
             , CreateBackup:=False
    
         ActiveWorkbook.Close 1
    Else
        MsgBox "未能导出文件或用户取消操作！", vbInformation, "提示"
    End If
    
End Sub

第一种是用拷贝粘贴，第二种用模板。

个人认为第二种更灵活。