如何復制一系列公式值並將它們粘貼到另一個工作表中的特定范圍？

Question

我試圖讓一個 excel 宏工作，但我在從包含公式的單元格中復制值時遇到問題。

到目前為止，這就是我所擁有的，它適用於非公式單元格。

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

我怎樣才能使它粘貼公式的值？

如果這可以改變/優化，我也會很感激。

Answer 1

你可以改變

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列（變量lastrowDB ）中DB表上的最后一個非空行。 如果您需要為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

---

您也可以使用 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

Answer 2

如果您將工作表中的每一列復制到不同的工作表如何？ 示例：mysheet 的 B 行到 sheet1 的 B 行，mysheet 的 C 行到 sheet 2 的 B 行......