多表求不重复值VBA

nnsea

Sub test()
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
    c = sh.Name
    If sh.Name <> "品名" Then

        arr = sh.Range("a1:a" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
        For Each Rng In arr
            d(Rng) = ""
        Next
    End If
Next
[a1].Resize(d.Count) = Application.Transpose(d.keys)
End Sub