VBA Transfer information from sheets in workbook 1, to sheets with same sheetname in another workbook -
i want transfer information target workbook source workbook when target sheet name source sheet name.
i realtively new vba, have been working 2 weeks , have literally googled a$$ off. website has proven best hulp far.
i have transpose information on standard basis different format, want fi want automate following code:
sub transfer() dim wbt workbook, wbs workbook 'wbt = workbook target, wbs = workbooksource dim wst worksheet, wss worksheet 'wbt = worksheet target, wbs = worksheet source dim wkt integer, wks integer, wke integer 'wkt = number in target sheet name, wks = number in source sheet name, wke = number in sheet name after want stop transferring information dim vfile variant dim cct range, ccs range set wbt = activeworkbook vfile = application.getopenfilename("excel-files,*.xlsm", _ 1, "select 1 file open", , false) if typename(vfile) = "boolean" exit sub workbooks.open vfile set wbs = activeworkbook wkt = 1 wks = 1 wke = 16 each wks in wbt.wst.("wk " & wkt) if wks = wkt wbt.wst("wk " & wkt).range("k13:k63").value = wbs.wss("wk " & wks).range("g8:g58").value wbt.wst("wk " & wkt).range("m13:m63").value = wbs.wss("wk " & wks).range("h8:h58").value wkt = wkt + 1 wks = wks + 1 if wke > wkt wbs.close (false) next end sub
this better :
sub transfer() dim wbt workbook, wbs workbook 'wbt = workbook target, wbs = workbooksource dim wst worksheet, wss worksheet 'wbt = worksheet target, wbs = worksheet source dim wkt integer, wks integer, wke integer 'wkt = number in target sheet name, wks = number in source sheet name, wke = number in sheet name after want stop transferring information dim vfile variant dim cct range, ccs range set wbt = activeworkbook vfile = application.getopenfilename("excel-files,*.xlsm", _ 1, "select 1 file open", , false) if typename(vfile) = "boolean" exit sub set wbs = workbooks.open(vfile) ' wkt = 1 ' wks = 1 wke = 16 each wss in wbs.sheets each wst in wbt.sheets if wst.name <> wss.name or cint(replace(wss.name, "wk ", "")) >= wke else wst.range("k13:k63").value = wss.range("g8:g58").value 'wbt.wst("wk " & wkt).range("m13:m63").value = wbs.wss("wk " & wks).range("h8:h58").value ' wkt = wkt + 1 ' wks = wks + 1 end if ' if wke > wkt wbs.close (false) next wst next wss wbs.close set wbs = nothing set wbt = nothing end sub
i don't "wke", number in sheetname on want limit copy? if is, code might changed enough already.
btw, set
kind of way create quicker references later use in code can't add arguments in there , have free them @ end of code, set ... = nothing
Comments
Post a Comment