使用vba创建新工作簿时出错,复制许多工作表中的2个

时间:2016-05-17 15:22:27

标签: excel vba

以下代码会生成一个包含我想要的2个工作表的.xls。只有我不会仅仅使用价值观......格式化就在那里(我不认为它应该是。粘贴。值。该死的。),而.xls有一个牢不可破的链接不需要在那里的原始文件(而且我认为不应该在那里)。所有单元格只包含值,不包含源工作簿中包含的任何公式。

当我打开新创建的.xls时,我会收到消息" [ws name]的文件格式和扩展名.xls不匹配。该文件可能已损坏或不安全。除非你相信它的来源,否则不要打开它。你想打开它吗?"

我厌恶缺乏信任.. :)

我做错了什么?

Sub QUOTE_ITEM_OUTPUT()

    Dim ws As Worksheet

    Dim Filename As String
    Dim Filelocation As String
    Dim UserName As String
    Dim Password As String

        Filename = Worksheets("CALCULATION PAGE").Range("ITEMNUM").Value & "_" & Worksheets("CALCULATION PAGE").Range("PDFSAVEREV").Value & ".xls"
        Filelocation = "\\GSWGS\Apps\Global\FILES\Import\GWS-Upload-TST\"

    With Application
        .ScreenUpdating = False

         '       Copy specific sheets
        Sheets(Array("ITEM OUTPUT", "ROUTING")).Copy

         '       Paste sheets as values
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

        ActiveWorkbook.SaveCopyAs Filelocation & Filename
        ActiveWorkbook.Close SaveChanges:=False

        .ScreenUpdating = True
    End With
End Sub

2 个答案:

答案 0 :(得分:1)

使用另一个子来“清理”表格

Sub ApplyValuesTo(ByVal sh As Excel.Worksheet)

    For Each cell In sh.UsedRange.Cells
        With cell
            .Value = .Value
            '// This may take a while; the next line will allow you to manually 
            '// break if needed (e.g. If you have a lot of data in the sheet)
            DoEvents 
        End With
    Next

End Sub

答案 1 :(得分:1)

您保存为.xls文件,但未在saveAs方法中指定该文件格式。这就是你收到安全警告的原因......

您需要在SaveAs方法中指定该参数。

ActiveWorkbook.SaveAs Filename:=Filelocation & Filename, FileFormat:=56

以下是各种fileFormat参数的MSDN页面链接: https://msdn.microsoft.com/en-us/library/office/ff198017.aspx

编辑 - 您遇到的第二个问题:

至于格式是否被传输,这是因为您没有使用正确的枚举值。

ws.[A1].PasteSpecial Paste:=xlValues

应该是:

ws.[A1].PasteSpecial Paste:=xlPasteValues