excel - Macro imports text file into multiple worksheets, I just want it all to import into one -


... , have "***" between each file

here's have far:

sub combinetextfiles() dim filestoopen dim x integer dim wkball workbook dim wkbtemp workbook dim sdelimiter string on error goto errhandler application.screenupdating = false sdelimiter = "|"  filestoopen = application.getopenfilename _   (filefilter:="text files (*.txt), *.txt", _   multiselect:=true, title:="text files open")  if typename(filestoopen) = "boolean"     msgbox "no files selected"     goto exithandler end if  x = 1 set wkbtemp = workbooks.open(filename:=filestoopen(x)) wkbtemp.sheets(1).copy set wkball = activeworkbook wkbtemp.close (false) wkball.worksheets(x).columns("a:a").texttocolumns _   destination:=range("a1"), datatype:=xldelimited, _   textqualifier:=xldoublequote, _   consecutivedelimiter:=false, _   tab:=false, semicolon:=false, _   comma:=false, space:=false, _   other:=true, otherchar:="|" x = x + 1  while x <= ubound(filestoopen)     set wkbtemp = workbooks.open(filename:=filestoopen(x))     wkball         wkbtemp.sheets(1).move after:=.sheets(.sheets.count)         .worksheets(x).columns("a:a").texttocolumns _           destination:=range("a1"), datatype:=xldelimited, _           textqualifier:=xldoublequote, _           consecutivedelimiter:=false, _           tab:=false, semicolon:=false, _           comma:=false, space:=false, _           other:=true, otherchar:=sdelimiter     end     x = x + 1 wend  exithandler: application.screenupdating = true set wkball = nothing set wkbtemp = nothing exit sub  errhandler: msgbox err.description resume exithandler end sub 

i able copy website haven't been able find code imports multiple 1 , adds spacer between each file.

your code pretty complete. added error handler make sure had target worksheet on active workbook along minor modifications added series of asterisks after each imported txt block.

sub combinetextfiles()     dim filestoopen variant     dim x long     dim wstxt worksheet, wkball workbook, wkbtemp workbook     dim sdelimiter string      on error goto missing_txt_ws     set wkball = activeworkbook     set wstxt = wkball.worksheets("txt_all")      'uncomment next line if want start fresh     'wstxt.cells(1, 1).currentregion.clearcontents      on error goto errhandler     application.screenupdating = false     sdelimiter = chr(124)   'e.g. "|"      filestoopen = application.getopenfilename _       (filefilter:="text files (*.txt), *.txt", _       multiselect:=true, title:="text files open")      if typename(filestoopen) = "boolean"         msgbox "no files selected"         goto exithandler     end if      x = lbound(filestoopen) ubound(filestoopen)         'debug.print filestoopen(x)         set wkbtemp = workbooks.open(filename:=filestoopen(x), readonly:=true)         wkbtemp.sheets(1)             .columns(1).texttocolumns _                   destination:=.cells(1, 1), _                   datatype:=xldelimited, _                   textqualifier:=xldoublequote, _                   consecutivedelimiter:=false, _                   tab:=false, semicolon:=false, _                   comma:=false, space:=false, _                   other:=true, otherchar:=sdelimiter             .cells(1, 1).currentregion.copy _               destination:=wstxt.cells(rows.count, 1).end(xlup).offset(1, 0)             wstxt.cells(rows.count, 1).end(xlup).offset(1, 0) = string(32, chr(42))         end         wkbtemp.close false     next x      wstxt         if not cbool(application.counta(.rows(1))) .rows(1).entirerow.delete     end      goto exithandler  missing_txt_ws:     if err.number = 9         wkball             .sheets.add after:=sheets(sheets.count)             .sheets(sheets.count).name = "txt_all"         end         resume     end if     exit sub  errhandler:     msgbox err.description     resume exithandler  exithandler:     application.screenupdating = true     set wstxt = nothing     set wkball = nothing     set wkbtemp = nothing  end sub 

Comments

Popular posts from this blog

c - Bitwise operation with (signed) enum value -

xslt - Unnest parent nodes by child node -

YouTubePlayerFragment cannot be cast to android.support.v4.app.Fragment -