here piece of code have written formatting task on various excel files in particular folder. problem runs on 1st worksheet of excel workbooks in folder. not able loop through individual worksheets of excel files. please me edit code. thanks
sub loopallexcelfilesinfolder() 'purpose: loop through excel files in user specified folder , perform set task on them 'source: www.thespreadsheetguru.com dim wb workbook dim mypath string dim myfile string dim myextension string dim fldrpicker filedialog 'optimize macro speed application.screenupdating = false application.enableevents = false application.calculation = xlcalculationmanual 'retrieve target folder path user set fldrpicker = application.filedialog(msofiledialogfolderpicker) fldrpicker .title = "select target folder" .allowmultiselect = false if .show <> -1 goto nextcode mypath = .selecteditems(1) & "\" end 'in case of cancel nextcode: mypath = mypath if mypath = "" goto resetsettings 'target file extension (must include wildcard "*") myextension = "*.xls" 'target path ending extention myfile = dir(mypath & myextension) 'loop through each excel file in folder while myfile <> "" 'set variable equal opened workbook set wb = workbooks.open(filename:=mypath & myfile) 'change layout application.printcommunication = false activesheet.pagesetup .printtitlerows = "" .printtitlecolumns = "" end application.printcommunication = true activesheet.pagesetup.printarea = "" application.printcommunication = false activesheet.pagesetup .leftheader = "" .centerheader = "" .rightheader = "" .leftfooter = "" .centerfooter = "" .rightfooter = "" .leftmargin = application.inchestopoints(0.7) .rightmargin = application.inchestopoints(0.7) .topmargin = application.inchestopoints(0.75) .bottommargin = application.inchestopoints(0.75) .headermargin = application.inchestopoints(0.3) .footermargin = application.inchestopoints(0.3) .printheadings = false .printgridlines = false .printcomments = xlprintnocomments .printquality = 600 .centerhorizontally = false .centervertically = false .orientation = xllandscape .draft = false .papersize = xlpaperletter .firstpagenumber = xlautomatic .order = xldownthenover .blackandwhite = false .zoom = false .fittopageswide = 1 .fittopagestall = false .printerrors = xlprinterrorsdisplayed .oddandevenpagesheaderfooter = false .differentfirstpageheaderfooter = false .scalewithdocheaderfooter = true .alignmarginsheaderfooter = true .evenpage.leftheader.text = "" .evenpage.centerheader.text = "" .evenpage.rightheader.text = "" .evenpage.leftfooter.text = "" .evenpage.centerfooter.text = "" .evenpage.rightfooter.text = "" .firstpage.leftheader.text = "" .firstpage.centerheader.text = "" .firstpage.rightheader.text = "" .firstpage.leftfooter.text = "" .firstpage.centerfooter.text = "" .firstpage.rightfooter.text = "" end 'save , close workbook wb.close savechanges:=true 'get next file name myfile = dir loop 'message box when tasks completed msgbox "task complete!" resetsettings: 'reset macro optimization settings application.enableevents = true application.calculation = xlcalculationautomatic application.screenupdating = true end sub
ou need loop through sheets in workbook, added dim sht worksheet
sub loopallexcelfilesinfolder() 'purpose: loop through excel files in user specified folder , perform set task on them 'source: www.thespreadsheetguru.com dim wb workbook dim sht worksheet dim mypath string dim myfile string dim myextension string dim fldrpicker filedialog 'optimize macro speed application.screenupdating = false application.enableevents = false application.calculation = xlcalculationmanual 'retrieve target folder path user set fldrpicker = application.filedialog(msofiledialogfolderpicker) fldrpicker .title = "select target folder" .allowmultiselect = false if .show <> -1 goto nextcode mypath = .selecteditems(1) & "\" end 'in case of cancel nextcode: mypath = mypath if mypath = "" goto resetsettings 'target file extension (must include wildcard "*") myextension = "*.xls" 'target path ending extention myfile = dir(mypath & myextension) 'loop through each excel file in folder while myfile <> "" 'set variable equal opened workbook set wb = workbooks.open(filename:=mypath & myfile) ' added line, loop through worksheets in current wb each sht in wb.worksheets 'change layout application.printcommunication = false sht.pagesetup .printtitlerows = "" .printtitlecolumns = "" end application.printcommunication = true activesheet.pagesetup.printarea = "" application.printcommunication = false sht.pagesetup .leftheader = "" .centerheader = "" .rightheader = "" .leftfooter = "" .centerfooter = "" .rightfooter = "" .leftmargin = application.inchestopoints(0.7) .rightmargin = application.inchestopoints(0.7) .topmargin = application.inchestopoints(0.75) .bottommargin = application.inchestopoints(0.75) .headermargin = application.inchestopoints(0.3) .footermargin = application.inchestopoints(0.3) .printheadings = false .printgridlines = false .printcomments = xlprintnocomments .printquality = 600 .centerhorizontally = false .centervertically = false .orientation = xllandscape .draft = false .papersize = xlpaperletter .firstpagenumber = xlautomatic .order = xldownthenover .blackandwhite = false .zoom = false .fittopageswide = 1 .fittopagestall = false .printerrors = xlprinterrorsdisplayed .oddandevenpagesheaderfooter = false .differentfirstpageheaderfooter = false .scalewithdocheaderfooter = true .alignmarginsheaderfooter = true .evenpage.leftheader.text = "" .evenpage.centerheader.text = "" .evenpage.rightheader.text = "" .evenpage.leftfooter.text = "" .evenpage.centerfooter.text = "" .evenpage.rightfooter.text = "" .firstpage.leftheader.text = "" .firstpage.centerheader.text = "" .firstpage.rightheader.text = "" .firstpage.leftfooter.text = "" .firstpage.centerfooter.text = "" .firstpage.rightfooter.text = "" end next sht 'save , close workbook wb.close savechanges:=true 'get next file name myfile = dir loop 'message box when tasks completed msgbox "task complete!" resetsettings: 'reset macro optimization settings application.enableevents = true application.calculation = xlcalculationautomatic application.screenupdating = true end sub 
Comments
Post a Comment