复制范围和粘贴值在另一个工作表的特定范围 [英] Copy Range and Paste Values in another Sheet's specific Range

问题描述

我正在尝试让一个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

如何使它粘贴值？

如果这可以改变/优化，我也会很感激。

If this can be changed/optimized, I'd appreciate it too.

推荐答案

您可以更改

Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)

to

Range("B3:B65536").Copy 
Sheets("DB").Range("B" & lastrow).PasteSpecial xlPasteValues

BTW，如果你有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

注意，上面的代码决定了中 DB中的最后一个非空行 c> >（变量 lastrowDB ）。如果您需要在 DB 表中找到每个目标列的最后一行，请使用下一个修改：

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

---

您还可以使用下一个方法复制/粘贴特殊。替换

.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屋！