excel - How to store the output files in the same folder as the original workbook -
i have vba below. works in vba module whenever insert module in new excel workbook. wish store in personal.xlsb , run whenever need it.
can please advise how can modify output files (for example: data 1, data 2, data 3... data 99999) stored in same folder original workbook?
sub splitfixedrows() dim wb workbook dim thissheet worksheet dim numofcolumns integer dim rangetocopy range dim rangeofheader range dim workbookcounter integer dim rowsinfile application.screenupdating = false rowsinfile = inputbox("please enter data size +1 header (example: 11, 101, 501): ") set thissheet = thisworkbook.activesheet numofcolumns = thissheet.usedrange.columns.count workbookcounter = 1 set rangeofheader = thissheet.range(thissheet.cells(1, 1), thissheet.cells(1, numofcolumns)) p = 2 thissheet.usedrange.rows.count step rowsinfile - 1 set wb = workbooks.add rangeofheader.copy wb.sheets(1).range("a1") set rangetocopy = thissheet.range(thissheet.cells(p, 1), thissheet.cells(p + rowsinfile - 2, numofcolumns)) rangetocopy.copy wb.sheets(1).range("a2") wb.saveas thisworkbook.path & "\data" & workbookcounter wb.close workbookcounter = workbookcounter + 1 next p application.screenupdating = true set wb = nothing end sub
you need keep reference original workbook. in following code set wborig
activeworkbook
when code starts (and use object instead of thisworkbook
).
sub splitfixedrows() dim wborig workbook dim wb workbook dim thissheet worksheet dim numofcolumns integer dim rangetocopy range dim rangeofheader range dim workbookcounter integer dim rowsinfile application.screenupdating = false rowsinfile = inputbox("please enter data size +1 header (example: 11, 101, 501): ") set wborig = activeworkbook set thissheet = wborig.activesheet numofcolumns = thissheet.usedrange.columns.count workbookcounter = 1 set rangeofheader = thissheet.range(thissheet.cells(1, 1), thissheet.cells(1, numofcolumns)) p = 2 thissheet.usedrange.rows.count step rowsinfile - 1 set wb = workbooks.add rangeofheader.copy wb.sheets(1).range("a1") set rangetocopy = thissheet.range(thissheet.cells(p, 1), thissheet.cells(p + rowsinfile - 2, numofcolumns)) rangetocopy.copy wb.sheets(1).range("a2") wb.saveas wborig.path & "\data" & workbookcounter wb.close workbookcounter = workbookcounter + 1 next p application.screenupdating = true set wb = nothing end sub
Comments
Post a Comment