VBA打开多个工作簿，复制特定数据，删除重复行，并将信息粘贴到新工作簿中

Sub CopyDataToNewWorkbook()
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim uniqueValues As Collection
    Dim cellValue As Variant
    
    ' 打开源工作簿
    Set sourceWorkbook = Workbooks.Open("C:\Path\To\SourceWorkbook.xlsx")
    ' 打开目标工作簿
    Set targetWorkbook = Workbooks.Add
    
    ' 设置源工作表
    Set sourceWorksheet = sourceWorkbook.Worksheets("Sheet1")
    ' 设置目标工作表
    Set targetWorksheet = targetWorkbook.Worksheets("Sheet1")
    
    ' 获取源工作表中最后一行的行号
    lastRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
    
    ' 创建一个集合对象，用于存储唯一的数值
    Set uniqueValues = New Collection
    
    ' 复制特定数据并删除重复行
    For i = 1 To lastRow
        cellValue = sourceWorksheet.Cells(i, 1).Value
        ' 检查数值是否已存在于集合中
        On Error Resume Next
        uniqueValues.Add cellValue, CStr(cellValue)
        On Error GoTo 0
    Next i
    
    ' 将唯一的数值粘贴到目标工作表中
    For j = 1 To uniqueValues.Count
        targetWorksheet.Cells(j, 1).Value = uniqueValues(j)
    Next j
    
    ' 保存目标工作簿
    targetWorkbook.SaveAs "C:\Path\To\TargetWorkbook.xlsx"
    
    ' 关闭工作簿
    sourceWorkbook.Close
    targetWorkbook.Close
    
    ' 释放对象变量
    Set sourceWorksheet = Nothing
    Set targetWorksheet = Nothing
    Set sourceWorkbook = Nothing
    Set targetWorkbook = Nothing
    Set uniqueValues = Nothing
    
    MsgBox "任务已完成！"
End Sub