excel vba - Copy duplicates and unique to sheets -

i use codes separate duplicates sheet(dup). want separate singles/unique records sheet(unique) 1 worksheet there 2 more sheets 1 of unique records , other of duplicates.

option explicit   sub findcpy()      dim lw long      dim integer      dim sh worksheet       set sh = sheets("dup")      lw = range("a" & rows.count).end(xlup).row       = 1 lw 'find duplicates list.         if application.countif(range("a" & & ":a" & lw), range("a" & i).text) > 1              range("b" & i).value = 1          end if      next       range("a1:b10000").autofilter , field:=2, criteria1:=1      range("a2", range("a65536").end(xlup)).entirerow.copy      sh.range("a65536").end(xlup).offset(1, 0).pastespecial xlpastevalues      selection.autofilter  end sub 

you're on right track. can use following route unique , duplicate values different sheets. can modify code suit needs (only display duplicate values once on duplicate sheet, example).

sub routeuniqueandduplicatevalues()     dim lastrow long     dim ws worksheet     dim dupes worksheet     dim unique worksheet     dim rng range      set ws = thisworkbook.sheets("data")     set dupes = thisworkbook.sheets("dupes")     set unique = thisworkbook.sheets("unique")      ws.autofiltermode = false      lastrow = ws.range("a" & ws.rows.count).end(xlup).row      ws.range("b1").formula = "=countif(a$1:a$" & lastrow & ", a1)"     ws.range("b1").copy ws.range("b2:b" & lastrow)      set rng = ws.range("a1:b" & lastrow)     rng         ' find dupes         .autofilter , field:=2, criteria1:=">1"         ' copy them our dupes sheet         .offset(1, 0).specialcells(xlcelltypevisible).copy dupes.range("a1")         ' find unique         .autofilter , field:=2, criteria1:=1         ' copy them our unique sheet         .offset(1, 0).specialcells(xlcelltypevisible).copy unique.range("a1")     end     ws.autofiltermode = false  end sub