Excel VBA: How to copy entire range including hidden columns -


i'm looking vba macro export data csv. found this code after tweaking great job. however, when copying range, excel seems ignore hidden columns while want csv contain columns. has discovered concise way code this?

here code have far:

sub exportlistortable(optional newbook boolean, optional willnamesheet boolean, optional ascsv boolean, optional visibleonly boolean) 'sub copylistortable2newworksheet() 'works in excel 2003 , excel 2007. copies visible data. 'code source: https://msdn.microsoft.com/en-us/library/dd637097%28v=office.11%29.aspx 'improved by: tzvi '   - replaced new worksheet new workbook  'params: '   newbook: create new new sheet in current workbook or (default) in new workbook '   willnamesheet: offer user name sheet or (default) leave default names '   ascsv: not implemented - save csv '   visibleonly: filter out hidden columns - default false  'todo '   -add parameter list following options: '   - if table not selected, copy activesheet.usedrange '   - optional savefiletype '   -   dim new_ws worksheet dim acell, data range dim ccount long dim activecellintable boolean dim copyformats, retrysave variant dim sheetname, user, defaultfilename, filesavename string dim userchoice boolean  'check see if worksheet or workbook protected. todo may not necessary anymore if activeworkbook.protectstructure = true or activesheet.protectcontents = true     msgbox "this macro not work when workbook or worksheet write-protected."         exit sub     end if      'set reference activecell. can use acell     'point cell, no matter in workbook.     set acell = activecell      'test see if acell in table or list. note using acell.listobject,     'do not need know name of table work it.     on error resume next     activecellintable = (acell.listobject.name <> "")     on error goto 0      'todo here select fields export     'if cell in list or table run code.     if activecellintable = true         application             .screenupdating = false             .enableevents = false         end         if visibleonly = true             'test if there more 8192 separate areas. excel supports             'a maximum of 8,192 non-contiguous areas through vba macros , manual.             on error resume next             acell.listobject.listcolumns(1).range 'todo remove "with"                 ccount = .specialcells(xlcelltypevisible).areas(1).cells.count             end             on error goto 0              if ccount = 0                 msgbox "there more 8192 individual areas, not possible " & _                        "copy visible data new worksheet. tip: sort " & _                        "data before apply filter , try macro again.", _                        vbokonly, "copy new worksheet"                 exit sub             else                 'copy visible cells.                 acell.listobject.range.copy             end if         else             'the user indicated wants copy hidden columns too.             '**********************************************************             'how implement part?             '**********************************************************              msgbox ("you wanted copy hidden columns too?")             activesheet.usedrange.copy         end if     else '        msgbox "select cell in list or table before run macro.", _ '           vbokonly, "copy new worksheet"         userchoice = msgbox("a table/table protion not selected. want export entire page?", vbyesno)         if userchoice = false exit sub         activesheet.usedrange.copy         'exit sub     end if             'add new worksheet/workbook.             if newbook = false                 set new_ws = worksheets.add(after:=sheets(activesheet.index))             else                 set new_ws = workbooks.add(xlwbatworksheet).worksheets(1)             end if              'prompt user worksheet name.             if willnamesheet = true                 sheetname = inputbox("what name of new worksheet?", _                                      "name new sheet")                  on error resume next                 new_ws.name = sheetname                 if err.number > 0                     msgbox "change name of sheet : " & new_ws.name & _                          " manually after macro ready. sheet name" & _                          " typed in exists or use characters" & _                          " not allowed in sheet name."                     err.clear                 end if                 on error goto 0             end if              'paste data new worksheet.             new_ws.range("a1")                 .pastespecial xlpastecolumnwidths                 .pastespecial xlpastevaluesandnumberformats                 .select                 application.cutcopymode = false             end              application.screenupdating = false              'if did not create table, have option copy formats.             if activecellintable = false                 application.goto acell                 copyformats = msgbox("do want copy formatting?", _                                      vbokcancel + vbexclamation, "copy new worksheet")                 if copyformats = vbok                     acell.listobject.range.copy                     new_ws.range("a1")                         .pastespecial xlpasteformats                         application.cutcopymode = false                     end                 end if             end if          'select new worksheet if not active.         application.goto new_ws.range("a1")          application             .screenupdating = true             .enableevents = true         end          'now we're ready save our new file excel format         defaultfilename = activeworkbook.name         user = environ("userprofile")  'marker getfilename: return if need new filename getfilename:         chdir user & "\desktop"         filesavename = application.getsaveasfilename(defaultfilename & ".csv", "comma delimited format (*.csv), *.csv")          if filesavename <> "false"             'error handling 'file exists , user clicks 'no'             on error resume next             activeworkbook.saveas filename:=filesavename, fileformat:=xlcsv, readonlyrecommended:=true, createbackup:=false, conflictresolution:=xluserresolution             if err.number = 1004                 'offer user 2 options: try different filename or cancel entire export                 retrysave = msgbox(err.description, vbretrycancel, "error creating file")                 if retrysave = vbretry                     goto getfilename                 else                     goto cancelprocedure                 end if             end if             on error goto 0         else             goto cancelprocedure         end if  exit sub cancelprocedure:     activeworkbook.close savechanges:=false     exit sub end sub 

update:

in response shagans concern. parameter list on line 1 intended set macro such:

sub exportvisibleascsv     call exportlistortable(newbook:=true, willnamesheet:=false, ascsv:=true, visibleonly:=true) end sub 

updating example code available:

ok looking @ code posted, see bool named visibleonly don't see gets set. ability logic reach usedrange.copy entirely depends on being set false. comment above acell.listobject.range.copy indicates if reach statement copying visible cells. in order copy hidden cells, visibleonly need set false (bypassing rest of ccount stuff). interested in knowing how bool set , checking see value set when running code.

update 2:

you need set value of visibleonly boolean somehow.

here's code edited creates message box allows user "yes" or "no" "do want copy hidden data too?" answer dictate value of visibleonly in turn dictates flow enter.

in addition that, assumption acell.listobject.range.copy copy visible cells appears have been incorrect. instead being replaced specialcell type visible cells.

finally, vbyesno not return boolean value. instead returns vbyes or vbno vb type enumerators (value 6 , 7 respectively). setting bool value of vbyesno return true (as value exists , evaluates iferror).

so changed bit checks yes/no condition on userchoice (which no longer bool).

here's code:

dim acell, data range dim ccount long dim activecellintable boolean dim copyformats, retrysave variant dim sheetname, user, defaultfilename, filesavename string   'check see if worksheet or workbook protected. todo may not necessary anymore if activeworkbook.protectstructure = true or activesheet.protectcontents = true     msgbox "this macro not work when workbook or worksheet write-protected."         exit sub     end if      'set reference activecell. can use acell     'point cell, no matter in workbook.     set acell = activecell      'test see if acell in table or list. note using acell.listobject,     'do not need know name of table work it.     on error resume next     activecellintable = (acell.listobject.name <> "")     on error goto 0      'todo here select fields export     'if cell in list or table run code.     if activecellintable = true         copyhidden = msgbox("would copy hidden data also?", vbyesno, "copy hidden data?")         if copyhidden = vbyes             visibleonly = false         elseif copyhidden = vbno             visibleonly = true         end if          application             .screenupdating = false             .enableevents = false         end         if visibleonly = true             'test if there more 8192 separate areas. excel supports             'a maximum of 8,192 non-contiguous areas through vba macros , manual.             on error resume next             acell.listobject.listcolumns(1).range 'todo remove "with"                 ccount = .specialcells(xlcelltypevisible).areas(1).cells.count             end             on error goto 0              if ccount = 0                 msgbox "there more 8192 individual areas, not possible " & _                        "copy visible data new worksheet. tip: sort " & _                        "data before apply filter , try macro again.", _                        vbokonly, "copy new worksheet"                 exit sub             else                 'copy visible cells.                 acell.listobject.range.specialcells(xlcelltypevisible).copy                 ' visible cells within table in clipboard             end if         else             'the user indicated wants copy hidden columns too.             msgbox ("you wanted copy hidden columns too?")             acell.listobject.range.copy             ' table data cells including hidden in clipboard         end if     else '        msgbox "select cell in list or table before run macro.", _ '           vbokonly, "copy new worksheet"         userchoice = msgbox("a table/table protion not selected. want export entire page?", vbyesno)         if userchoice = vbno exit sub         activesheet.usedrange.copy         'entire sheet range in clipboard (this not accurate)         'exit sub     end if 

Comments

Popular posts from this blog

css - SVG using textPath a symbol not rendering in Firefox -

Java 8 + Maven Javadoc plugin: Error fetching URL -

datatable - Matlab struct computations -