复制值不是公式excel vba

Question

我有一段代码将一行从一个excel复制到另一个excel。 问题是列E到G和N到O都有对另一个excel的引用，当它复制时，它复制公式而不是单元格值，导致按降序将公式重复到目标列。 我试过隐藏/取消隐藏，但它没有太大的区别。 目标列D将导致D1 = 1.xslm / sheet1 / formula（n1）; D2 = 2.xslm / sheet1 / formula（n2）... - 这是源表格列D的参考。在源中，值是正确的，在目标中公式是错误的，它不应该有n1 ，n2 ...... 如果源行在目标中为122，则应为D1 = 1.xslm / sheet1 / formula（n122），D2 = 2.xslm / sheet1 / formula（n122）

Sub copy1()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Sour As String
    Dim Tar As String
    Dim path As String
    Dim AutoSR As Workbook
    Dim asrSheet As Worksheet
    Set AutoSR = ActiveWorkbook
    Set Target = AutoSR.ActiveSheet

    path = "c:\first.xlsm"
    Tar = "Sheet1"
    Set Source = Workbooks.Open(path).Sheets(Tar)
    Source.Unprotect Password:="XXX"
    Application.DisplayAlerts = False
    Columns("E:G").EntireColumn.Hidden = False
    Columns("N:O").EntireColumn.Hidden = False
    Source.Range("N:O").EntireColumn.Hidden = True
    For Each c In Source.Range("a1:a" & Cells.SpecialCells(xlCellTypeLastCell).Row)
        If c = lNum Then
           Source.Rows(c.Row).Copy Target.Rows(1)
        End If
    Next c
    Source.Range("E:G").EntireColumn.Hidden = True
    Source.Range("N:O").EntireColumn.Hidden = True
    Source.Protect Password:="XXX"
    Source.Activate
    ActiveWorkbook.Close SaveChanges:=True
    Set Source = Nothing

End Sub

Answer 1

更换：

Source.Rows(c.Row).Copy Target.Rows(1)

通过：

Source.Rows(c.Row).Copy 
Target.Rows(1).PasteSpecial xlPasteValues

这将粘贴值而不是公式

编辑这个答案是一个快速和肮脏的解决方案！ 查看答案形式Jeeped，以便更广泛地改进OP的代码。

Answer 2

首先，看看这一行。

For Each c In Source.Range("a1:a" & Cells.SpecialCells(xlCellTypeLastCell).Row)

Cells.SpecialCells(...没有显式引用Source工作表。它隐含地引用了ActiveSheet属性 。巧合的是，这也恰好是Source工作表，因为打开该工作簿使它成为ActiveSheet。但是，这应该是不能依赖。最好明确定义所有Range.Parent工作表属性。

For Each c In Source.Range("a1:a" & SOURCE.Cells.SpecialCells(xlCellTypeLastCell).Row)

就复制值而言，您可以使用带有xlPasteValues的xlPasteType的Range.PasteSpecial方法 。 但是，直接值传输是一种更有效的传输值的方法，它不涉及剪贴板或.CutCopyMode 。

替换所有这一切，

For Each c In Source.Range("a1:a" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    If c = lNum Then
       Source.Rows(c.Row).Copy Target.Rows(1)
    End If
Next c

... 有了这个，

Dim rw as Variant
With Source
    rw = Application.Match(lNum, .Columns(1), 0)
    If Not IsError(rw) Then
        With .Range(.Cells(rw, "A"), .Cells(rw, .Columns.Count).End(xlToLeft))
            Target.Cells(1, 1).Resize(.Rows.Count, .Columns.Count) = .Value
        End With
    End If
End With

这将从列A到匹配行上的最后一个填充单元格的所有内容都包含源工作表，并将值传输到从列A1向外辐射的目标工作表。