VBA提取不重复值并复制格式

KenWu1234

各位老师大家好。

请帮我用VBA的方法实现，在sheet1的A列中提取不重复值到sheet2中的A列，并保留Sheet1中原数据的格式。

我在网上找了段代码，可以提取不重复值，但数据格式变了。

还请老师帮我改正一下。

Private Sub CommandButton1_Click() '提取不重复值，
       ActiveSheet.[a2:a200].Clear
       Set d = CreateObject("scripting.dictionary")
       arr = Sheet1.[a2:a15000]
            For i = 1 To UBound(arr)
                 If arr(i, 1) <> "" Then d(arr(i, 1)) = ""
            Next i

            ActiveSheet.[a2].Resize(d.Count, 1) = Application.Transpose(d.keys)
        

   
End Sub