復制值不是公式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向外輻射的目標工作表。