excel vba - Copying Dynamic Rows Into New Workbook and save it -

excel vba - Copying Dynamic Rows Into New Workbook and save it -

i'm new in here. have search solution find needed.

i found part of reply in post : copying dynamic cells/rows new sheet or workbook

but there 2 more specific actions need , cant figure out in way. first thing save new workbooks name of "key" @ same place original file. sec thing re-create first line every new workbooks. here illustration : in db, key sorted alpha , bravo , rest...

original database (db):

name position key bruce 1 alpha bruce 2 alpha alfred 2 alpha alfred 3 bravo robin 1 bravo robin 1 bravo

in first workbook like:

name position key bruce 1 alpha bruce 2 alpha alfred 2 alpha

and workbook save "alpha.xlsx" in same directory original database (in file on desktop) , close window

then 2nd workbook be

name position key alfred 3 bravo robin 1 bravo robin 1 bravo

saved name "bravo.xlsx" in same file on desktop , close , maintain going 400 keys

here code post found in forum: the original code written chilinut made update fit db

sub grabber() dim thisworkbook workbook set thisworkbook = activeworkbook lastly = 1 = 1 564336 'my db had 500k rows if range("a" & i) <> range("a" & (i + 1)) range("a" & lastly & ":n" & i).copy set newbook = workbooks.add newbook.sheets("feuil1").range("a1").pastespecial xlpastevalues lastly = + 1 thisworkbook.activate end if next end sub

this vba works doesn't re-create first line every time , not save it. have around 400 "keys" become hard handle manually. i'm not specialist @ all.

can please re-create total code in reply able figure out ? give thanks in advance help. read lot of post , figure out , help people. give thanks that.

and understood english language not first language. sorry error , false grammar.

thank in advance!

you (worked on pc info example). remember add together microsoft scripting runtime create dictionary work:

sub grabber() dim thisws worksheet: set thisws = activeworkbook.activesheet 'to create dictionaries work, , line create sense, need reference microsoft scripting runtime, tools-> references, , check of "microsoft scripting runtime" dim mydict new scripting.dictionary dim pathtonewwb string dim currentpath, columnwithkey, numcols, numrows, uniquekeys, ukey 'to avoid screenupdating beingness false in case of unforseen errors, want programme jump unfreeze if errors occur on error goto unfreeze 'with 400 keys end lot of flicker + speeds up: application.screenupdating = false 'get path of active workbook currentpath = application.activeworkbook.path 'i hardcode reference key column columnwithkey = 3 'and assume worksheet "just" data, why number of used rows , columns can used identify info numcols = thisws.usedrange.columns.count 'extract index of lastly used row in active sheet of active workbook numrows = thisws.usedrange.rows.count 'use dictionary list of unique keys running on key column in used rows = 2 numrows vkey = thisws.cells(i, columnwithkey) if not mydict.exists(vkey) mydict.add vkey, 1 end if next uniquekeys = mydict.keys() each ukey in uniquekeys pathtonewwb = currentpath & "/" & ukey & ".xlsx" 'filter keys column unique key thisws.range(thisws.cells(1, 1), thisws.cells(numrows, numcols)).autofilter field:=columnwithkey, criteria1:=ukey 'copy sheet thisws.usedrange.copy 'open new workbook, chang sheets(1) name , paste values, before saveas , close set newbook = workbooks.add newbook .sheets(1).name = "feuil1" .sheets(1).range("a1").pastespecial xlpastevalues .saveas pathtonewwb .close end 'remove autofilter (paranoid parrot) thisws.autofiltermode = false next set mydict = nil unfreeze: application.screenupdating = true end sub

in adapting code provided, used next posts:

for dictionary: (does vba have dictionary structure?)

for autofilter: (vba filtering columns)

for saveas & close: (excel vba open workbook, perform actions, save as, close)

excel-vba