以下代码仅供参考，如有错误之处欢迎指正交流。
Sub 合并并删除重复项()
Dim wb As Workbook '定义工作簿变量
Dim ws1 As Worksheet '定义Sheet1变量
Dim ws2 As Worksheet '定义Sheet2变量
Dim ws3 As Worksheet '定义Sheet3变量
Dim lastRow As Long '定义最后一行变量
Dim i As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
'设置工作簿和工作表
Set wb = ThisWorkbook '当前工作簿
Set ws1 = wb.Sheets("Sheet1") 'Sheet1工作表
Set ws2 = wb.Sheets("Sheet2") 'Sheet2工作表
Set ws3 = wb.Sheets("Sheet3") 'Sheet3工作表
'清除Sheet3中的数据
ws3.Cells.ClearContents
'将Sheet1中的数据复制到Sheet3
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row '获取最后一行
ws1.Range("A1").CurrentRegion.Copy ws3.Range("A1") '复制数据到Sheet3
'将Sheet2中的数据复制到Sheet3
lastRow = ws3.Cells(Rows.Count, 1).End(xlUp).Row '获取最后一行
ws2.Range("A1").CurrentRegion.Offset(1).Copy ws3.Range("A" & lastRow + 1) '复制数据到Sheet3
'获取sheet3中A列最后一行行号
lastRow = ws3.Cells(Rows.Count, 1).End(xlUp).Row '获取最后一行
'遍历A列所有单元格
For i = lastRow To 1 Step -1
'判断单元格的值是否在字典中出现过，如果出现过，则删除整行数据
If dict.Exists(ws3.Cells(i, "A").Value) Then
ws3.Rows(i).Delete
Else
dict(ws3.Cells(i, "A").Value) = 1
End If
Next i
'向用户显示合并完成的消息
MsgBox "合并并删除重复项成功!"
End Sub