Excel VBA- Modify code so data transferred from 'Invoice' sheet to 'Sales Book' sheet save to a different workbook instead -
i have code, sends data 'invoice' sheet 'sales book' sheet, after consideration feel beneficial have data sent different workbook altogether. how implement using code below (as took me ages far!!). here code- original question. solved , updated below-
the code below works. last issue resolve fact data copied on copies on empty item rows. found simple solution copy code below pic here. it's auto run vba code deletes row if there no data in cell. help. feel invincible!
sub sendtosales() dim wb workbook '''! dim currentwb workbook '''! dim wbloc string '''! dim rng range dim long dim long dim rng_dest range application.screenupdating = false wbloc = "c:\salestracker.xlsm" '''! location of workbook, trimmed down public view set currentwb = excel.thisworkbook '''! set wb = workbooks.open(wbloc) '''! opens workbook = 1 set rng_dest = wb.sheets("salestracker").range("d:f") '''! change sheets() whichever sheet want use ' find first empty row in columns d:f on sheet sales book until worksheetfunction.counta(rng_dest.rows(i)) = 0 = + 1 loop 'copy range a23:d27 on sheet invoice variant array set rng = currentwb.sheets("invoice").range("a23:d27") '''! ' copy rows containing values sheet sales book = 1 rng.rows.count if worksheetfunction.counta(rng.rows(a)) <> 0 rng_dest.rows(i).value = rng.rows(a).value wb.sheets("salestracker") '''! change sheets() whichever sheet want use 'copy invoice number .range("b" & i).value = currentwb.sheets("invoice").range("c18").value '''! 'copy date .range("a" & i).value = currentwb.sheets("invoice").range("c15").value '''! 'copy company name .range("c" & i).value = currentwb.sheets("invoice").range("a7").value '''! end '''! = + 1 end if next wb.close savechanges:=true '''! wil close workbook , save changes set wb = nothing '''! cleaning memory set currentwb = nothing '''! cleaning memory application.screenupdating = true end sub
here code deletes rows have no data in cell, f in case-
sub killemptyf() on error resume next columns("f").specialcells(xlcelltypeblanks).entirerow.delete end sub
and here code auto run module whenever workbook opened-
sub auto_run() run ("killemptyf") end sub
something should work. i've added/edited i've marked '''!
.
sub sendtosales() dim wb workbook '''! dim currentwb workbook '''! dim wbloc string '''! dim rng range dim long dim long dim rng_dest range application.screenupdating = false wbloc = "c:\documents\salestracker.xlsm" '''! location of workbook set currentwb = excel.thisworkbook '''! set wb = workbooks.open(wbloc) '''! opens workbook = 1 set rng_dest = wb.sheets(1).range("d:f") '''! change sheets() whichever sheet want use ' find first empty row in columns d:f on sheet sales book until worksheetfunction.counta(rng_dest.rows(i)) = 0 = + 1 loop 'copy range a23:d27 on sheet invoice variant array set rng = currentwb.sheets("invoice").range("a23:d27") '''! ' copy rows containing values sheet sales book = 1 rng.rows.count if worksheetfunction.counta(rng.rows(a)) <> 0 rng_dest.rows(i).value = rng.rows(a).value wb.sheets(1) '''! change sheets() whichever sheet want use 'copy invoice number .range("b" & i).value = currentwb.sheets("invoice").range("c18").value '''! 'copy date .range("a" & i).value = currentwb.sheets("invoice").range("c15").value '''! 'copy company name .range("c" & i).value = currentwb.sheets("invoice").range("a7").value '''! end '''! = + 1 end if next wb.close savechanges:=true '''! wil close workbook , save changes set wb = nothing '''! cleaning memory set currentwb = nothing '''! cleaning memory application.screenupdating = true end sub
Comments
Post a Comment