Excel 如何从一个工作簿复制数据，并仅将值粘贴到另一个工作簿中，并且只允许宏运行一次？

当我意外地运行VBA代码多次将数据从一个工作簿复制/粘贴到目标工作簿时，它将在目标工作表中创建多个具有相同数据的行。

我希望VBA代码识别前一行是相同的，以防止数据重复

此外，我的VBA代码将把公式复制到我的目标Excel文件中。
我只想复制值，而不是公式。我不知道如何在我的VBA代码中使用

PasteSpecial

Sub-Copy\u-Paste\u在最后一个单元格下方（）
将wsDest设置为工作表
昏暗的天空和漫长的天空一样
设置wsDest=工作簿（“Destination.xlsx”）。工作表（“数据库”）
lDestLastRow=wsDest.Cells（wsDest.Rows.Count，“C”）.End（xlUp）.Offset（1）.Row
'如何在此处使用PasteSpecial Paste:=xlPasteValues？
活页4.范围（“B6:F6”）。复制wsDest.范围（“C”和lDestLastRow）
端接头

编辑：

Sub-Copy\u-Paste\u在\u Last\u Cell1（）下方
将wsDest设置为工作表
昏暗的天空和漫长的天空一样
设置wsDest=工作簿（“Destination.xlsx”）。工作表（“数据库”）
lDestLastRow=wsDest.Cells（wsDest.Rows.Count，“C”）.End（xlUp）.Offset（1）.Row
如果sheetWithVariable.CellWithVariable.Value=False，则
表4.范围（“B6:F6”）。副本
wsDest.Range（“C”&lDestLastRow）.Paste特殊粘贴：=xlPasteValues
sheetWithVariable.CellWithVariable.Value=True
如果结束
端接头

进入“开发者选项卡”，然后按“录制宏”，或者在Excel左下方有一个小按钮“录制宏”。然后你按下它，它会为你的每次点击、按下等自动创建代码，所以只复制和粘贴值，停止录制宏。您将拥有模块1，其中包含如何“粘贴值”的代码。

对于

粘贴特殊的

功能，复制和粘贴被定义为不同的操作（也就是说，

复制时不应使用
目标
选项）：

如果希望代码只运行一次，请在工作簿中的某个位置添加一个变量，该变量将指定代码已运行。诸如此类：

Sub Copy_Paste_Below_Last_Cell()
  If sheetWithVariable.CellWithVariable.Value = False Then
    ' Put your code here
    sheetWithVariable.CellWithVariable.Value = True
  End If
End Sub

任务：从主工作簿复制并粘贴到目标工作簿中
没有重复数据

这应该可以做到。在尝试之前，请调整代码的配置部分

Sub TransferData()

Dim main_wb As Workbook, target_wb As Workbook, main_sheet As String
Dim r As String, target_sheet As String, first_col As Byte, col_n As Byte
Dim next_row As Long, duplicates As Byte, pasted As Byte, last_col As Long

'CONFIG HERE
'------------------------
Set main_wb = ThisWorkbook
main_sheet = "Sheet1"
r = "B6:F6" 'range to copy in the main Workbook

'target workbook path
Set target_wb = _
Workbooks.Open("/Users/user/Desktop/target workbook.xlsm")

target_sheet = "Sheet1"
first_col = 3 'in what column does the data starts in target sheet?
'-------------------------

'turn screen updating off
Application.ScreenUpdating = False

'copy from main
main_wb.Sheets(main_sheet).Range(r).Copy

With target_wb.Sheets(target_sheet)

    'target info
    next_row = _
    .Cells(Rows.Count, first_col).End(xlUp).Row + 1
    
    'paste in target
    .Cells(next_row, first_col).PasteSpecial xlPasteValues
    
    last_col = _
    .Cells(next_row, Columns.Count).End(xlToLeft).Column

End With

pasted = last_col - (first_col - 1)

For col_n = first_col To last_col

    With target_wb.Sheets(target_sheet)

        If .Cells(next_row, col_n) = .Cells(next_row - 1, col_n) Then
             
             duplicates = duplicates + 1
             
        End If

    End With

Next col_n

If duplicates = pasted Then 'if the nº of cells pasted equals duplicates
    
    For col_n = first_col To last_col  'erase pasted range
        target_wb.Sheets(target_sheet).Cells(next_row, col_n).Clear
    Next col_n
    
End If

'turn screen updating back on
Application.ScreenUpdating = True

End Sub

嗨，ENIAC，谢谢你的解决方案！当我运行您给出的第二个解决方案时，有一个错误提到变量未定义。我可以知道原因吗？我用我的最新代码编辑了我的帖子，谢谢@weizer，您应该使用工作表的名称和存储变量的单元格地址，而不是
sheetWithVariable.CellWithVariable.Value
。类似这样的内容：
Sheet1.Range（“A1”）.Value
或
工作表（“Sheet 1”）.Range（“A1”）.Value
更新了我在代码中的注释。将您的代码放入
If
块中。感谢您的解决方案，但我对VBA比较陌生，我不知道如何将我的代码与您的代码结合起来，尽管我可以大致理解您的代码。似乎代码只检查它是否与上面的行相同，并返回真/假？您理解正确。好的，我会修改你的代码。谢谢你！这个解决方案对我来说非常有效！我很高兴它做到了；）
Sub TransferData()

Dim main_wb As Workbook, target_wb As Workbook, main_sheet As String
Dim r As String, target_sheet As String, first_col As Byte, col_n As Byte
Dim next_row As Long, duplicates As Byte, pasted As Byte, last_col As Long

'CONFIG HERE
'------------------------
Set main_wb = ThisWorkbook
main_sheet = "Sheet1"
r = "B6:F6" 'range to copy in the main Workbook

'target workbook path
Set target_wb = _
Workbooks.Open("/Users/user/Desktop/target workbook.xlsm")

target_sheet = "Sheet1"
first_col = 3 'in what column does the data starts in target sheet?
'-------------------------

'turn screen updating off
Application.ScreenUpdating = False

'copy from main
main_wb.Sheets(main_sheet).Range(r).Copy

With target_wb.Sheets(target_sheet)

    'target info
    next_row = _
    .Cells(Rows.Count, first_col).End(xlUp).Row + 1
    
    'paste in target
    .Cells(next_row, first_col).PasteSpecial xlPasteValues
    
    last_col = _
    .Cells(next_row, Columns.Count).End(xlToLeft).Column

End With

pasted = last_col - (first_col - 1)

For col_n = first_col To last_col

    With target_wb.Sheets(target_sheet)

        If .Cells(next_row, col_n) = .Cells(next_row - 1, col_n) Then
             
             duplicates = duplicates + 1
             
        End If

    End With

Next col_n

If duplicates = pasted Then 'if the nº of cells pasted equals duplicates
    
    For col_n = first_col To last_col  'erase pasted range
        target_wb.Sheets(target_sheet).Cells(next_row, col_n).Clear
    Next col_n
    
End If

'turn screen updating back on
Application.ScreenUpdating = True

End Sub