复制值不是公式excel vba

我有一段代码，从一个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(...并没有明确指向源工作表，它隐含地引用了ActiveSheet属性，巧合的是，这也恰好是源工作表，因为打开该工作簿使其成为ActiveSheet。不要依赖，最好是明确定义所有的Range.Parent工作表属性。

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

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

replace所有这些，

 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列发出的目标工作表。