excel - Conditionally copy cells to new workbook -

excel - Conditionally copy cells to new workbook -

i haven't worked vba while , here's i'm trying do: have worksheet column of id numbers, , bunch of columns create reference whether person id has done ("1") or not ("0"). this:

id task1 task2 task3 103 1 1 0 129 0 1 0 154 1 1 1 189 1 0 1 204 0 1 1

what want macro create new workbook each task (and save workbook under name of task), , populate each workbook id #s of have completed task. so, there should should create , save workbook called "task1" has values 103, 154, , 189 in column a, create , save separate workbook called "task2" has values 103, 129, 154, , 204 in column a, , on.

i haven't been successful far. came this:

sub copytoworkbooks() dim lrow, lcol integer sheets("sheet1").select lrow = range("a" & rows.count).end(xlup).row lcol = cells(1, columns.count).end(xltoleft).column each cell in range(cells(1, "b"), cells(1, lcol)) union(range("a1:a" & lrow), range(cells(1, cell.column), cells(lrow, cell.column))).copy workbooks.add range("a1").pastespecial activeworkbook.saveas filename:= _ "users:user:desktop:workbookfolder:" & cell.value & ".xls" 'for saving workbook on mac activeworkbook.close next cell application.cutcopymode = false end sub

this creates , save 3 separate workbooks right workbook names, copies of values in column , of values in column corresponds new workbook name. so, example, workbook "task2" looks this:

id task2 103 1 129 1 154 1 189 0 204 1

any help appreciated. thanks!

i have made couple of changes code in order accomplish task have described:

sub copytoworkbooks() dim lrow integer dim lcol integer dim integer dim j integer dim tcount integer dim ws worksheet dim taskarr variant application.screenupdating = false set ws = activeworkbook.sheets("sheet1") ws.select lrow = ws.cells(ws.rows.count, 1).end(xlup).row lcol = ws.cells(1, columns.count).end(xltoleft).column 'loops through each column = 2 lcol step 1 redim taskarr(1 2, 1 1) tcount = 1 taskarr(1, tcount) = ws.cells(1, 1).value taskarr(2, tcount) = ws.cells(1, i).value 'loops through each row j = 2 lrow step 1 if ws.cells(j, i).value = 1 tcount = tcount + 1 'read values array redim preserve taskarr(1 2, 1 tcount) taskarr(1, tcount) = ws.cells(j, 1).value taskarr(2, tcount) = ws.cells(j, i).value end if next j 'add new workbook workbooks.add activesheet.range("a1", activesheet.cells(tcount, 2).address) = worksheetfunction.transpose(taskarr) activeworkbook.saveas filename:="users:user:desktop:workbookfolder:" & ws.cells(1, i).value & ".xls" 'for saving workbook on mac activeworkbook.close erase taskarr next application.screenupdating = true end sub

instead of copying/pasting values, read values each task array , inserts sheet in destination workbook.

excel excel-vba