Vba 将工作表的值复制到新工作簿

Vba 将工作表的值复制到新工作簿,vba,excel,Vba,Excel,我试图做一些看似简单的事情,但却不断给我带来麻烦 将活动工作表复制到不带公式的新工作簿中 我用以下代码尝试了我的运气: Sub test() ActiveSheet.Copy With ActiveSheet.UsedRange .Value = .Value End With End Sub 但这是相当不可靠的,因为它有时不会复制明显有值的字段。 我有一个单元格,需要在同一个该死的单元格中有粗体和正常大小不同的文本 上述方法不保留该格式 我目前正在做的事情如下所示: Sub Eksp

我试图做一些看似简单的事情,但却不断给我带来麻烦

将活动工作表复制到不带公式的新工作簿中

我用以下代码尝试了我的运气:

Sub test()
ActiveSheet.Copy
With ActiveSheet.UsedRange
    .Value = .Value
End With
End Sub
但这是相当不可靠的,因为它有时不会复制明显有值的字段。 我有一个单元格,需要在同一个该死的单元格中有粗体和正常大小不同的文本

上述方法不保留该格式

我目前正在做的事情如下所示:

Sub EksporterExcel()
Dim ws As Worksheet
Dim wb As Workbook
Dim tid As String

Set ws = Sheets(ActiveSheet.Name)
tid = Format(CStr(Now), "hh.mm.ss")

Application.DisplayAlerts = False
Application.ScreenUpdating = False

ws.Copy
Set wb = Workbooks(ActiveWorkbook.Name)
ws.UsedRange.Copy
wb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

ActiveWorkbook.SaveAs _
        FileFormat:=51, _
        Filename:=Application.ThisWorkbook.Path & "\Udfyldte Indleveringsplaner\Excel\" & Date & "\" & ActiveSheet.Name & " Kl. " & tid & ".xlsx"

ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
这就行了

然而,它是缓慢的。非常非常慢。我假设这必须先复制工作表,然后再返回以复制单元格值,所以我想找到一种避免这种情况的方法

这种方式也不会将格式保存在具有多个格式选项的单个单元格中。然而,这是低优先级的

我很想知道是否有更有效的方法

下面是使用第一段代码或jkpieterse的答案中的代码时的结果示例

在复制之前,先复制原始工作表

复印件

一些数据在被复制后明显丢失了

这个版本怎么样(也整理了一些代码):


“没有公式”是什么意思?是否作为值粘贴到目标?将空值粘贴到源中有公式的目标中?我需要用户在查看工作表时看到的值。显然,这与.Value不同。在所有情况下,第一段代码都是不可靠的。速度太慢的原因是您正在遍历整个工作簿/工作表。我可以通过简单地说明需要复制的范围来避免这种情况吗?工作表有一个固定的大小。使用
ws.UsedRange.Copy
稍微快一点,但这里的问题与上面的小代码片段问题不大。由于某些原因,并非所有值都被实际复制,而且复制的值似乎没有模式。我将在原始帖子中上传两张图片来说明问题,听起来好像你的原始工作表(部分)被破坏了。工作表是否包含任何合并的单元格?如果是这样的话,如果你先取消合并,会发生什么?为了我自己的利益,合并的单元格太多了,但我对此无能为力。你看,这并不完全取决于我。为了实验的缘故,我试着把它们取出来,但问题仍然存在。我想你可以放心地认为这张纸已经损坏了。最好的办法是插入一个新的工作表,然后将所有内容从旧的复制粘贴到新的。然后尝试“复制工作表”技巧,查看新工作表是否按预期复制。如果再次失败,您必须通过复制和粘贴公式来重新创建工作表。一步一个脚印,在每一个中间步骤都要重新尝试工作表副本。哦,孩子。。。那是大量的抄袭。工作簿中有15页。嗯,我有点想这么做,因为出于某种原因,VBA中有两张幻影表。
Sub EksporterExcel()
    Dim tid As String

    tid = Format(CStr(Now), "hh.mm.ss")

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    ActiveSheet.Copy

    ActiveSheet.UsedRange.Value2 = ActiveSheet.UsedRange.Value2

    ActiveWorkbook.SaveAs _
            FileFormat:=51, _
            Filename:=Application.ThisWorkbook.Path & "\Udfyldte Indleveringsplaner\Excel\" & Date & "\" & ActiveSheet.Name & " Kl. " & tid & ".xlsx"
    'Assume it is the active workbook you wanted to close...
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub