good day pros, please can put me in right direction, trying select multiple columns column header in excel sheet, copy these columns new work book, when code below, excel open 1 book per column instead of pasting of selected columns sheet1 of new workbook. please help. (i have come across different solutions, didnt how make them work me, guess due lack of experience, recorded macro task worked well, problem column header changes every time can not depend on recorded macros). thank you.
sub colheadr() dim wso worksheet 'dim wsf worksheet....i comment out line dim integer application.screenupdating = false set wso = activesheet 'set wsf = worksheets("final").....i comment out line mycolumns = array("facility", "last name", "first name", "mrn", "adm date") wso.range("a1:w1") = 0 ubound(mycolumns) on error resume next .find(mycolumns(i)).entirecolumn.copy workbook.add activesheet.paste 'destination:=wsf.cells(1, + 1)...i comment out line err.clear next end set wso = nothing set wsf = nothing application.screenupdating = true end sub
try out:
public sub copybetweenbooks() dim mycollection collection dim myiterator variant dim myrng range dim xlcell variant dim otherwb workbook dim mywb workbook dim colcounter integer set mywb = thisworkbook set mycollection = new collection 'create collection of header names search through mycollection.add ("header1") mycollection.add ("header2") mycollection.add ("header3") 'where search, header set myrng = activesheet.range("a1:w1") set otherwb = workbooks.add colcounter = 0 each xlcell in myrng.cells ' through each cell in header each myiterator in mycollection ' in each item in collection if myiterator = xlcell.value ' when header matches looking colcounter = colcounter + 1 ' creating column index new workbook mywb.activesheet.columns(xlcell.column).copy otherwb.activesheet.columns(colcounter).select otherwb.activesheet.paste end if next next end sub 