VBA实现查找相同并往下复制

PAN810622

名位老师，帮我看下，我想要实现在B列找开头是"H"的数据，且查找是否有一样的数据，如果一样，就在A列查找此数据，将包含此数据的项往下复制，并将其对应的A列的数据覆盖复制的A数据，最后将已经被复制的给删了

PAN810622

加上图片说明

PAN810622

Sub 多图号()
Dim I, J, K, X As Integer
K = Sheet1.Range("A65536").End(xlUp).Row
  For I = 1 To K
   For J = 1 To K
  If Mid(Sheet1.Range("B" & I), 1, 1) = "H" Then
    If Sheet1.Range("B" & I) = Sheet1.Range("B" & I + 1) Then
    If Sheet1.Range("A" & J) = Sheet1.Range("B" & I) Then
      Sheet1.Range("A" & J & ":B" & J).Copy Sheet1.Range("A" & K + 1)
      Sheet1.Range("A" & K + 1) = Sheet1.Range("A" & I)
   
End If
End If
End If
Next
  Next
我写的这段代码，但是我不知道前面要删的数据如何找到并删了，求各位帮看看

xjl565135022

语文不好，看半天看不懂题目

PAN810622

这样应该容易理解一点。HN300EPSZXS-0077有三个相同的，就要在A弄找包含HN300EPSZXS-0077的项，并且把其往下复制，复制下来的HN300EPSZXS-0077就要改相应的改为HN300EPSZXS-0080与HN300EPSZXS-0081，最后前面重复的HN300EPSZXS-0080、81整行删了