如何复制一系列公式值并将其粘贴到另一张工作表中的特定范围内? [英] How do I copy a range of formula values and paste them to a specific range in another sheet?
问题描述
我正在尝试使一个excel宏正常工作,但是从包含公式的单元格中复制值时遇到了问题.
I'm trying to get an excel macro to work but I'm having an issue with copying the values from formula-containing cells.
到目前为止,这就是我所拥有的,并且可以与非配方细胞正常工作.
So far this is what I have and it works fine with the non-formula cells.
Sub Get_Data()
Dim lastrow As Long
lastrow = Sheets("DB").Range("A65536").End(xlUp).Row + 1
Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)
Range("C3:C65536").Copy Destination:=Sheets("DB").Range("A" & lastrow)
Range("D3:D65536").Copy Destination:=Sheets("DB").Range("C" & lastrow)
Range("E3:E65536").Copy Destination:=Sheets("DB").Range("P" & lastrow)
Range("F3:F65536").Copy Destination:=Sheets("DB").Range("D" & lastrow)
Range("AH3:AH65536").Copy Destination:=Sheets("DB").Range("E" & lastrow)
Range("AIH3:AI65536").Copy Destination:=Sheets("DB").Range("G" & lastrow)
Range("AJ3:AJ65536").Copy Destination:=Sheets("DB").Range("F" & lastrow)
Range("J3:J65536").Copy Destination:=Sheets("DB").Range("H" & lastrow)
Range("P3:P65550").Copy Destination:=Sheets("DB").Range("I" & lastrow)
Range("AF3:AF65536").Copy Destination:=Sheets("DB").Range("J" & lastrow)
End Sub
如何制作它以便粘贴公式的值?
How can I make it so it pastes the values for formulas?
如果可以更改/优化此设置,我也将不胜感激.
If this can be changed/optimized, I'd appreciate it too.
推荐答案
您可以更改
Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)
到
Range("B3:B65536").Copy
Sheets("DB").Range("B" & lastrow).PasteSpecial xlPasteValues
顺便说一句,如果您具有xls文件(excel 2003),并且您的lastrow
大于3,则会收到错误消息.
BTW, if you have xls file (excel 2003), you would get an error if your lastrow
would be greater 3.
尝试改用以下代码:
Sub Get_Data()
Dim lastrowDB As Long, lastrow As Long
Dim arr1, arr2, i As Integer
With Sheets("DB")
lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
arr1 = Array("B", "C", "D", "E", "F", "AH", "AI", "AJ", "J", "P", "AF")
arr2 = Array("B", "A", "C", "P", "D", "E", "G", "F", "H", "I", "J")
For i = LBound(arr1) To UBound(arr1)
With Sheets("Sheet1")
lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
End With
Next
Application.CutCopyMode = False
End Sub
注意,上面的代码确定列A
(变量lastrowDB
)中DB
工作表上的最后一个非空行.如果需要为DB
工作表中的每个目标列查找lastrow,请使用下一个修改:
Note, above code determines last non empty row on DB
sheet in column A
(variable lastrowDB
). If you need to find lastrow for each destination column in DB
sheet, use next modification:
For i = LBound(arr1) To UBound(arr1)
With Sheets("DB")
lastrowDB = .Cells(.Rows.Count, arr2(i)).End(xlUp).Row + 1
End With
' NEXT CODE
Next
您也可以使用下一种方法代替Copy/PasteSpecial
.替换
You could also use next approach instead Copy/PasteSpecial
. Replace
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
使用
Sheets("DB").Range(arr2(i) & lastrowDB).Resize(lastrow - 2).Value = _
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Value
这篇关于如何复制一系列公式值并将其粘贴到另一张工作表中的特定范围内?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!