如何把这三个数据一起选择 一起粘贴

顶

排序

Option Explicit
Sub abc()
　Dim i, m, d(1)
　For i = 0 To UBound(d)
　　Set d(i) = CreateObject("scripting.dictionary")
　Next
　For i = 2 To Cells(Rows.Count, "a").End(xlUp).Row
　　If Not d(0).exists(Cells(i, "d").Value) Then d(0)(Cells(i, "d").Value) = i
　　d(1)(Cells(i, "d").Value) = d(1)(Cells(i, "d").Value) + 1
　Next
　For Each i In d(1).keys
　　If d(1)(i) > 1 Then
　　　m = m + 1
　　　Cells(d(0)(i), "a").Resize(, 4).Copy Cells(m + 2, "f")
　　End If
　Next
End Sub

使用ctrl键

筛选，把刘大珍去掉再复制