after searching lot on internet tried combine working excel vba code reads .csv files in folder excel file (each on seperate worksheet). thing need combine csv files in 1 worksheet....
the working code is:
working file seperate worksheets
sub example12() dim mypath string dim filesinpath string dim myfiles() string dim sourcercount long dim fnum long dim mybook workbook dim basebook workbook 'fill in path\folder files 'on machine mypath = "c:\data" 'add slash @ end if user forget if right(mypath, 1) <> "\" mypath = mypath & "\" end if 'if there no excel files in folder exit sub filesinpath = dir(mypath & "*.csv") if filesinpath = "" msgbox "no files found" exit sub end if on error goto cleanup application.screenupdating = false set basebook = thisworkbook 'fill array(myfiles)with list of excel files in folder fnum = 0 while filesinpath <> "" fnum = fnum + 1 redim preserve myfiles(1 fnum) myfiles(fnum) = filesinpath filesinpath = dir() loop 'loop through files in array(myfiles) if fnum > 0 fnum = lbound(myfiles) ubound(myfiles) set mybook = workbooks.open(mypath & myfiles(fnum)) mybook.worksheets(1).copy after:= _ basebook.sheets(basebook.sheets.count) on error resume next activesheet.name = mybook.name on error goto 0 ' can use if want copy values ' activesheet.usedrange ' .value = .value ' end mybook.close savechanges:=false next fnum end if cleanup: application.screenupdating = true end sub --------------------------------------------------------- change i've made change part vba copies sheet "after" last one, append existing sheet "totaal". not working code --------------------------------------------------------- sub example12() dim mypath string dim filesinpath string dim myfiles() string dim sourcercount long dim fnum long dim mybook workbook dim basebook workbook 'fill in path\folder files 'on machine mypath = "c:\data" 'add slash @ end if user forget if right(mypath, 1) <> "\" mypath = mypath & "\" end if 'if there no excel files in folder exit sub filesinpath = dir(mypath & "*.csv") if filesinpath = "" msgbox "no files found" exit sub end if on error goto cleanup application.screenupdating = false set basebook = thisworkbook 'fill array(myfiles)with list of excel files in folder fnum = 0 while filesinpath <> "" fnum = fnum + 1 redim preserve myfiles(1 fnum) myfiles(fnum) = filesinpath filesinpath = dir() loop 'loop through files in array(myfiles) if fnum > 0 fnum = lbound(myfiles) ubound(myfiles) set mybook = workbooks.open(mypath & myfiles(fnum)) mybook.worksheets(1).copy **basebook.sheets("totaal").select nextrow = cells(rows.count, 0).end(xlup).row cells(nextrow, 1).select activesheet.paste** on error resume next activesheet.name = mybook.name on error goto 0 ' can use if want copy values ' activesheet.usedrange.value = .value ' end mybook.close savechanges:=false next fnum end if cleanup: application.screenupdating = true end sub i haven't got knowledge change :(. on right track?
all input appreciated!
extra info: data in csv files put in first column. after whole merging process planned split columns afterwards....
thanks!
after set basebook = thisworkbook
enter this:
dim nextrow integer dim wstotal worksheet set wstotal = basebook.worksheets("total") and here corrected loop:
'loop through files in array(myfiles) if fnum > 0 fnum = lbound(myfiles) ubound(myfiles) 'open file set mybook = workbooks.open(mypath & myfiles(fnum)) wstotal 'activate if want (optional) '.activate 'copy data on sheet mybook.worksheets(1).usedrange.copy 'find next empty row nextrow = .range("a1").specialcells(xlcelltypelastcell).row + 1 'select if desired (optional) '.cells(nextrow, 1).select 'paste data .cells(nextrow, 1).pastespecial (xlpasteall) 'turn off copy mode application.cutcopymode = false 'do want change worksheet name? .name = mybook.name end 'close file mybook.close savechanges:=false next fnum 
Comments
Post a Comment