excel - If Cell.Value is specific size, Copy 3 cells in that row to new sheet -


i have excel document fill out tshirt sizes, names, , numbers. goal here is... once form filled out, can hit button copy smalls , put them onto new sheet, mediums, onto another, , on. can select whole row, want copy few cells. pasting them @ point same row on new sheet in old sheet. want them show on next available line. here examples...

in excel sheet(1) "main"

b                  c               d ----------------------------------------- **name**         | size          | #    | ----------------------------------------- joe                small           1              there other sarah              x-small         3              instructions on peter              large           6              here on side sam                medium          12             of document ben                small           14             important rick               large           26 

in excel sheet(2) "small" should be

b                  c               d ----------------------------------------- **name**         | size          | #    | ----------------------------------------- joe                small           1 ben                small           14 

in excel sheet(2) "small" happening

b                  c               d ----------------------------------------- **name**         | size          | #    | ----------------------------------------- joe                small           1              there other    ben                small           14             important 

here vba code far

private sub commandbutton1_click() each cell in sheets(1).range("b:b")     if cell.value = "small"         matchrow = cell.row         rows(matchrow & ":" & matchrow).select         selection.copy          sheets("small").select         activesheet.rows(matchrow).select         activesheet.paste         sheets("main").select     end if next 

on next size...

in first part, selecting entire row because row contains variable want in column b, don't need entire row, need select column b though d in row.

now understand "matchrow" why data pasting on same row copied from, i'm not sure how make go next available line either.

alternate method lots of bells , whistles. scott craner's answer far more practical considering current experience level, looking more advanced approach:

edit in comments, op provided sample data:

_____b_____  __c__  _d_ name         size     # joe 1-youth  small    2 ben 1-youth  small    7 bob 1-youth  small   10 joe 1-youth  small   13 joe 1-youth  small   22 joe 1-youth  small   32 joe 1-youth  small   99 joe 1-youth  small    1 joe 1-youth  small    3 joe 3-youth  large    6 joe 3-youth  large   11 joe 3-youth  large   21 

updated code , verified works provided sample data , original data:

sub tgr()      dim wb workbook     dim ws worksheet     dim wsmain worksheet     dim rcopy range     dim runqsizes range     dim sizecell range     dim sname string     dim lanswer long     dim long      set wb = activeworkbook     set wsmain = wb.sheets("main")      lanswer = msgbox(title:="run preference", _                      prompt:="click yes override existing data." & _                      chr(10) & "click no append data bottom of sheets." & _                      chr(10) & "click cancel quit macro , nothing.", _                      buttons:=vbyesnocancel)      if lanswer = vbcancel exit sub      wsmain.range("c1", wsmain.cells(rows.count, "c").end(xlup))         if .parent.filtermode .parent.showalldata         on error resume next         .advancedfilter xlfilterinplace, , , true         set runqsizes = .offset(1).resize(.rows.count - 1).specialcells(xlcelltypevisible)         on error goto 0         if runqsizes nothing             msgbox "no data found in column c", , "no data"             exit sub         end if         if .parent.filtermode .parent.showalldata          each sizecell in runqsizes             sname = sizecell.value             = 1 7                 sname = replace(sname, ":\/?*[]", " ")             next             sname = worksheetfunction.trim(left(sname, 31))             if not evaluate("isref('" & sname & "'!a1)")                 wb.sheets.add(after:=wb.sheets(wb.sheets.count)).name = sname                 set ws = wb.sheets(sname)                 wsmain.range("b1:d1").copy                 ws.range("b1").pastespecial xlpasteall                 ws.range("b1").pastespecial xlpastecolumnwidths                 application.cutcopymode = false             else                 set ws = wb.sheets(sname)             end if             .autofilter 1, sizecell.value             set rcopy = intersect(wsmain.range("b:d"), .offset(1).resize(.rows.count - 1).entirerow)             if lanswer = vbno                 rcopy.copy ws.cells(rows.count, "b").end(xlup).offset(1)             else                 ws.range("b2:d" & rows.count).clear                 rcopy.copy ws.range("b2")             end if         next sizecell         if .parent.filtermode .parent.showalldata     end  end sub 

Comments

Popular posts from this blog

how to insert data php javascript mysql with multiple array session 2 -

multithreading - Exception in Application constructor -

windows - CertCreateCertificateContext returns CRYPT_E_ASN1_BADTAG / 8009310b -