excel vba - Creating workbook based on two cell value -

i have workbook "report.xlsx" in have 70 sheets (the name of 70 sheets present on list in workbook called "list.xlsx"). need create workbook based on list present in "list.xlsx".

i have list this.

sheet name  person name fax            tom tax            tami rax            tom max            sara sax            tom 

what need code can move sheets of workbook "report.xlsx" , create workbook based on above list eg:

fax, rax & sax should copied new workbook "report.xlsx" , renamed tom. wise tax should copied new workbook , renamed tami. , same max should copied new workbook , renamed sara.

thanks in advance.

---

dear team,

below code tried, still unable needed, can on this.

sub copysheets() dim thiswb  string dim newwb string dim endofprocess string dim m integer         thiswb = activeworkbook.name         on error resume next          application.displayalerts = false         sheets("tempsheet").delete         application.displayalerts = true         on error goto 0         sheets.add         activesheet.name = "tempsheet"         sheets("list").select         if activesheet.autofiltermode             cells.select             on error resume next             activesheet.showalldata             on error goto 0     end if     columns("a:c").select     selection.copy     sheets("tempsheet").select     range("a1").select     activesheet.paste     columns("b").delete     application.cutcopymode = false         if (cells(1, 1) = "")             lastrowx = cells(1, 1).end(xldown).row             if lastrowx <> rows.count                 range("a1:a" & lastrowx - 1).select                 selection.delete shift:=xlup             end if         end if      cells.select     selection.sort _             key1:=range("b2"), order1:=xlascending, _             header:=xlyes, ordercustom:=1, _             matchcase:=false, orientation:=xltoptobottom, _             dataoption1:=xlsortnormal      lmaxsupp = cells(rows.count, 1).end(xlup).row     suppno = 2 lmaxsupp     windows(thiswb).activate     supname = sheets("tempsheet").range("b" & suppno)           if supname <> ""         workbooks.add         activeworkbook.saveas "balance sheet review - " & supname             newwb = "balance sheet review - " & supname         windows("balance sheet review dec 13 - apj.xlsm").activate  = 2 100  windows(""report.xlsx"").activate worksheets("tempsheet").activate             fldrname = left(cells(i, 1).value, 30)             worksheets(fldrname).activate              sheets(fldrname).select             sheets(fldrname).copy before:=workbooks( _         newwb & ".xlsx").sheets(1)    next           end if      next   end sub 

try put following code list.xlsx. code you've wrote not seems rewrite whole thing:

sub test() dim twb workbook dim nwb workbook dim rpt workbook dim tws worksheet dim sh worksheet dim bcnt integer dim wbn string dim wsn string dim wsexist boolean dim createnwb boolean dim sfile string dim spath string   set twb = thisworkbook ' list.xlsx set tws = twb.sheets("list") ' assume worksheet called list in list.xlsx  spath = "c:\" ' or source files stored sfile = dir(spath & "*.xlsx")  while len(sfile) > 0 set rpt = workbooks.open(spath & sfile) 'or file sits  twb.activate tws.activate  range("a1", range("b1").end(xldown)).select bcnt = selection.count selection.sort _             key1:=range("b2"), order1:=xlascending, _             header:=xlyes, ordercustom:=1, _             matchcase:=false, orientation:=xltoptobottom, _             dataoption1:=xlsortnormal   = 2 bcnt     wbn = cells(i, 2).value     wsn = cells(i, 1).value     wsexist = false     createnwb = false     if cells(i, 2).value <> cells(i - 1, 2).value         createnwb = true     end if      rpt.activate     each sh in worksheets         if sh.name = wsn             if createnwb = true                 set nwb = workbooks.add()             end if             'rpt.activate             sh.copy before:=nwb.sheets(1)             wsexist = true             exit         end if     next sh     twb.activate         if wsexist = true             if cells(i, 2).value <> cells(i + 1, 2).value             nwb.saveas filename:="c:\" & wbn             nwb.close             end if         end if  next sfile = dir loop end sub 

customize local path / file name , such. based on sample sheet name sits @ column (with col header) , person (workbook) name sits @ column b (with col header)