excel - vba copy and paste rows of data by salesperson into new workbooks by salesperson -
what have here sales report includes sales persons date range.
what need macro each salesperson, move sales new workbook, save workbook number , close.
here data looks , want macro do
i going include code hasn't been working , may not find useful, give idea of im trying accomplish
public function reportsummaries() dim row, col, origpersonslastrow, origsaleslastrow, integer dim original workbook dim cell range dim vendorssheet, rawdatasheet worksheet set original = application.workbooks("salesreportrpt (7).xlsm") set vendorssheet = original.worksheets("sales person") set rawdatasheet = original.worksheets("sheet1") 'optimize macro speed application.screenupdating = false application.enableevents = false application.calculation = xlcalculationmanual 'retrieve target folder path user set fldrpicker = application.filedialog(msofiledialogfolderpicker) fldrpicker .title = "select target folder" .allowmultiselect = false if .show <> -1 goto nextcode mypath = .selecteditems(1) & "\" end 'in case of cancel nextcode: mypath = mypath if mypath = "" goto resetsettings = 2 origpersonslastrow = vendorssheet.usedrange.rows.count origsaleslastrow = rawdatasheet.usedrange.rows.count 'msgbox origveodorslastrow j = 2 origpersonslastrow ' cell in vendorssheet.columns("a").cells set cell = vendorssheet.cells(j, 1) 'set y = workbooks.open(" path destination book ") 'if cell.value = 108 or cell.value = 30 ' goto nextwb 'end if set wb = workbooks.add wb application.displayalerts = false rawdatasheet.range("a1:k1").copy wb.sheets("sheet1").cells(1, 1) k = 2 origsaleslastrow ' each rawcell in rawdatasheet.columns("e").cells set rawcell = rawdatasheet.cells(k, 4) if cell.value = rawcell.value , rawcell.value <> "" , rawcell.value <> 108 'msgbox "matches" rawcell.entirerow.copy wb.sheets("sheet1").cells(i, 1) = + 1 elseif > 6 , cell.value = "" 'call bigreport 'goto done end if next k if cell.value <> "" wb.checkcompatibility = false until application.calculationstate = xldone: doevents: loop .saveas filename:=mypath & cell.value, fileformat:=xlnormal, createbackup:=false '.activate 'wb.activate '.sheets("sheet1").activate 'call bigreport(wb) .close savechanges:=true elseif > 6 goto done end if end nextwb: = 6 next j resetsettings: 'reset macro optimization settings application.enableevents = true application.displayalerts = true application.calculation = xlcalculationautomatic application.screenupdating = true done: 'exit sub 'call loopallexcelfilesinfolder end function
here answer offered @0m3r:
option explicit sub move_each_agent_to_sheet() ' // declare variables dim sht worksheet dim rng range dim list collection dim varvalue variant dim long ' // set sheet name set sht = activeworkbook.sheets("sheet1") ' // set auto-filter, a6 sht.range("a6") .autofilter end ' // set agent column range # (2) want filter set rng = range(sht.autofilter.range.columns(3).address) ' // create new collection object set list = new collection ' // fill collection unique values on error resume next = 2 rng.rows.count list.add rng.cells(i, 1), cstr(rng.cells(i, 1)) next ' // start looping in through collection values each varvalue in list ' // filter autofilter macth current value rng.autofilter field:=3, criteria1:=varvalue ' // copy autofiltered range new workbook sht.autofilter.range.copy worksheets.add.paste activesheet.name = left(varvalue, 30) cells.entirecolumn.autofit ' // loop next collection value next varvalue ' // go main sheet , removed filters sht.autofilter.showalldata sht.activate end sub this solves biggest problem extract different salespersons sales...
Comments
Post a Comment