复制范围并粘贴另一个工作表特定范围内的值
我试图让一个Excelmacros工作，但我有一个问题，从含有公式的单元格复制值。
到目前为止，这是我所拥有的，并且与非公式单元格一起工作良好。
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 我怎样才能使它粘贴的价值？
如果这可以改变/优化，我也会很感激。
你可以改变
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。
尝试使用此代码，而不是：
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 （variableslastrowDB ）中的DB表页上的最后一个非空行。 如果您需要在DB表中find每个目标列的lastrow，请使用下一个修改：
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 。 更换
.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
如果您要将表单中的每一列复制到不同的工作表，那怎么样？ 例如：mysheet的B行到sheet1的B行，mysheet的C行到sheet 2的行B …