使用VBA将值从一个表粘贴到另一个表

我有下面的VBA代码，它从图纸表格数据中获取一行，复制数据，然后将数据粘贴到图纸运行列表中的下一行。但是，原始行有公式，我需要粘贴的是值，而不是公式。我见过很多使用Range.PasteSpecial的方法，但是这段代码没有使用Range，我不知道如何合并它

注意：我从这里修改了此代码：。它最初有一个IF语句来匹配单元格中的内容，然后根据单元格中的内容将其粘贴到某个表中。我只有一张纸要复印，不需要IF。我也不需要找到要复制的最后一行数据，因为它只会是范围为A2:N2的一行。但是如果我去掉FinalRow部分和For，替换为RangeA2:N2，它就不起作用了，所以我把它们留在了里面

关于如何添加PasteValues属性而不使其变得更复杂，有什么指导吗？我也愿意简化For或FinalRow变量，比如使用Range。我只对VBA有点熟悉，用它做了一些事情，但通常是在大量搜索和修改代码之后

Public Sub CopyData()
Sheets("Tabled data").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
 ' Loop through each row
For x = 2 To FinalRow
    ThisValue = Cells(x, 1).Value
    Cells(x, 1).Resize(1, 14).Copy
    Sheets("Running list").Select
    NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste
    Sheets("Tabled data").Select
Next x
End Sub

---

希望我们能让这更简单

Public Sub CopyRows()
    Sheets("Sheet1").UsedRange.Copy
    lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    'check if the last cell found is empty
    If IsEmpty(ActiveSheet.Cells(lastrow, 1)) = True Then
        'if it is empty, then we should fill it
        nextrow = lastrow
    Else
        'if it is not empty, then we should not overwrite it
        nextrow = lastrow + 1
    End If

    ActiveSheet.Cells(nextrow, 1).Select
    ActiveSheet.Paste
End Sub

---

编辑：我对它进行了一点扩展，这样顶部就不会有一个空行了

我找到了一个可行的解决方案。我录制了一个宏以获取其中的“粘贴特殊”，并添加了额外的代码以查找下一个空行：

Sub Save_Results()
' Save_Results Macro
  Sheets("Summary").Select 'renamed sheets for clarification, this was 'Tabled data'
'copy the row  
  Range("Table1[Dataset Name]").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Selection.Copy
' paste values into the next empty row
  Sheets("Assessment Results").Select
  Range("A2").Select
  NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
  Cells(NextRow, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
' Return to main sheet      
Sheets("Data Assessment Tool").Select
End Sub

---

只需一次复制所有数据，无需一次复制一行

Sub CopyData()

    With ThisWorkbook.Sheets("Tabled data")
        Dim sourceRange As Range
        Set sourceRange = .Range(.Cells(2, 1), .Cells(getLastRow(.Range("A1").Parent), 14))
    End With

    With ThisWorkbook.Sheets("Running list")
        Dim pasteRow As Long
        Dim pasteRange As Range
        pasteRow = getLastRow(.Range("A1").Parent) + 1
        Set pasteRange = .Range(.Cells(pasteRow, 1), .Cells(pasteRow + sourceRange.Rows.Count, 14))
    End With

    pasteRange.Value = sourceRange.Value

End Sub
Function getLastRow(ws As Worksheet, Optional colNum As Long = 1) As Long

    getLastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row

End Function

Private Sub Load_Click()

    Call ImportInfo

End Sub

Sub ImportInfo()

    Dim FileName As String
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim ActiveListWB As Workbook
    Dim check As Integer

    'Application.ScreenUpdating = False
    Set WS2 = ActiveWorkbook.Sheets("KE_RAW")
        confirm = MsgBox("Select (.xlsx) Excel file for Data transfer." & vbNewLine & "Please ensure the sheets are named Sort List, Second and Third.", vbOKCancel)

    If confirm = 1 Then
        FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
                Title:="Select Active List to Import", MultiSelect:=False)

        If FileName = "False" Then
                MsgBox "Import procedure was canceled"
                Exit Sub
            Else
                Call CleanRaw
                Set ActiveListWB = Workbooks.Open(FileName)
        End If

        Set WS1 = ActiveListWB.Sheets("Sort List")
        WS1.UsedRange.Copy 'WS2.Range("A1")
       ' WS2.Range("A1").Select
        WS2.UsedRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'WS2.Range ("A1")
        ActiveWorkbook.Close False

     'Call ClearFormulas

       ' Call RefreshAllPivotTables

        Sheets("Key Entry Data").Select
        'Sheets("Raw").Visible = False
        'Application.ScreenUpdating = True
        MsgBox "Data has been imported to workbook"

    Else
        MsgBox "Import procedure was canceled"
    End If

        Application.ScreenUpdating = True

End Sub

Sub CleanRaw()

    Sheets("KE_RAW").Visible = True
    Sheets("KE_RAW").Activate
    ActiveSheet.Cells.Select
    Selection.ClearContents

End Sub