vba 如何复制一系列公式值并将它们粘贴到另一个工作表中的特定范围？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21648122/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How do I copy a range of formula values and paste them to a specific range in another sheet?
提问by BlueSun3k1
I'm trying to get an excel macro to work but I'm having an issue with copying the values from formula-containing cells.
我试图让一个 excel 宏工作，但我在从包含公式的单元格中复制值时遇到问题。
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.
如果这可以改变/优化，我也会很感激。
回答by Dmitry Pavliv
You can change
你可以改变
Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)
to
到
Range("B3:B65536").Copy
Sheets("DB").Range("B" & lastrow).PasteSpecial xlPasteValues
BTW, if you have xls file (excel 2003), you would get an error if your lastrowwould be greater 3.
顺便说一句，如果你有 xls 文件（excel 2003），如果你lastrow大于 3 ，你会得到一个错误。
Try to use this code instead:
尝试改用此代码：
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
Note, above code determines last non empty row on DBsheet in column A(variable lastrowDB). If you need to find lastrow for each destination column in DBsheet, use next modification:
请注意，上面的代码确定DB列A（变量lastrowDB）中工作表上的最后一个非空行。如果您需要为工作表中的每个目标列找到最后一行DB，请使用下一个修改：
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
You could also use next approach instead Copy/PasteSpecial. Replace
您也可以改用 next 方法Copy/PasteSpecial。代替
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
with
和
Sheets("DB").Range(arr2(i) & lastrowDB).Resize(lastrow - 2).Value = _
.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Value
回答by Gem
How about if you're copying each column in a sheet to different sheets? Example: row B of mysheet to row B of sheet1, row C of mysheet to row B of sheet 2...
如果您将工作表中的每一列复制到不同的工作表如何？示例：mysheet 的 B 行到 sheet1 的 B 行，mysheet 的 C 行到 sheet 2 的 B 行......
