Excel - Merge worksheets with different structure -
i have excel workbook on 100 worksheets of have different structure (some columns in of worksheets, not). there easy way merge worksheets columns have in common?
thank in advance!
do following:
- open vba editor window
- click “tools” file menu
- select “references” within tools menu
- scroll down until find “microsoft scripting runtime”
- check box next “microsoft scripting runtime”
- click ok
then paste excel vba module:
option explicit public sub combinesheetswithdifferentheaders() dim wksdst worksheet, wkssrc worksheet dim lngidx long, lnglastsrccolnum long, _ lngfinalheaderscounter long, lngfinalheaderssize long, _ lnglastsrcrownum long, lnglastdstrownum long dim strcolheader string dim varcolheader variant dim rngdst range, rngsrc range dim dicfinalheaders scripting.dictionary set dicfinalheaders = new scripting.dictionary 'set references up-front dicfinalheaders.comparemode = vbtextcompare lngfinalheaderscounter = 1 lngfinalheaderssize = dicfinalheaders.count set wksdst = thisworkbook.worksheets.add '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'start phase 1: prepare final headers , destination worksheet' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'first, loop through of data worksheets, 'building our final headers dictionary each wkssrc in thisworkbook.worksheets 'make sure skip destination worksheet! if wkssrc.name <> wksdst.name wkssrc 'loop through of headers on sheet, 'adding them final headers dictionary lnglastsrccolnum = lastoccupiedcolnum(wkssrc) lngidx = 1 lnglastsrccolnum 'if column header not exist in final 'headers dictionary, add , increment column number strcolheader = trim(cstr(.cells(1, lngidx))) if not dicfinalheaders.exists(strcolheader) dicfinalheaders.add key:=strcolheader, _ item:=lngfinalheaderscounter lngfinalheaderscounter = lngfinalheaderscounter + 1 end if next lngidx end end if next wkssrc 'wahoo! final headers dictionary contains every column 'header name worksheets. let's write these values 'the destination worksheet , finish phase 1 each varcolheader in dicfinalheaders.keys wksdst.cells(1, dicfinalheaders(varcolheader)) = cstr(varcolheader) next varcolheader ''''''''''''''''''''''''''''''''''''''''''''''' 'end phase 1: final headers ready rock!' ''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'start phase 2: write data each worksheet destination!' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'we begin phase 1 -- looping through each sheet each wkssrc in thisworkbook.worksheets 'once again, make sure skip destination worksheet! if wkssrc.name <> wksdst.name wkssrc 'identify last row , column on sheet 'so know when stop looping through data lnglastsrcrownum = lastoccupiedrownum(wkssrc) lnglastsrccolnum = lastoccupiedcolnum(wkssrc) 'identify last row of destination sheet 'so know (eventually) paste data lnglastdstrownum = lastoccupiedrownum(wksdst) 'loop through headers on sheet, looking 'the appropriate destination column final 'headers dictionary , creating ranges on fly lngidx = 1 lnglastsrccolnum strcolheader = trim(cstr(.cells(1, lngidx))) 'set destination target range using 'looked value final headers dictionary set rngdst = wksdst.cells(lnglastdstrownum + 1, _ dicfinalheaders(strcolheader)) 'set source target range using current 'column number , last-occupied row set rngsrc = .range(.cells(2, lngidx), _ .cells(lnglastsrcrownum, lngidx)) 'copy data sheet destination! rngsrc.copy destination:=rngdst next lngidx end end if next wkssrc 'yay! let user know data has been combined msgbox "data combined!" end sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'input : sheet, worksheet we'll search find last row 'output : long, last occupied row 'special case: if sheet empty, return 1 public function lastoccupiedrownum(sheet worksheet) long dim lng long if application.worksheetfunction.counta(sheet.cells) <> 0 sheet lng = .cells.find(what:="*", _ after:=.range("a1"), _ lookat:=xlpart, _ lookin:=xlformulas, _ searchorder:=xlbyrows, _ searchdirection:=xlprevious, _ matchcase:=false).row end else lng = 1 end if lastoccupiedrownum = lng end function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'input : sheet, worksheet we'll search find last column 'output : long, last occupied column 'special case: if sheet empty, return 1 public function lastoccupiedcolnum(sheet worksheet) long dim lng long if application.worksheetfunction.counta(sheet.cells) <> 0 sheet lng = .cells.find(what:="*", _ after:=.range("a1"), _ lookat:=xlpart, _ lookin:=xlformulas, _ searchorder:=xlbycolumns, _ searchdirection:=xlprevious, _ matchcase:=false).column end else lng = 1 end if lastoccupiedcolnum = lng end function then run macro.
original source adapted from: https://danwagner.co/how-to-combine-data-with-different-columns-on-multiple-sheets-into-a-single-sheet/
Comments
Post a Comment