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
Post a Comment