vba - Excel remove all empty rows 600 000 rows and reformat -
i have excel file 600 000 rows.
it looks this:
1 2 3 4 value1: 1 5 value2: 2 6 value3: 3 7 8 9 10 value1: 1 11 value2: 2 12 value3: 3 13 14 15 ... 599998: value1: 1 599999: value2: 2 600000: value3: 3 my goal remove empty rows , place values this:
b c 1 value1 value2 value3 2 ... i've tried selecting rows -> f5 special "empty values" says "selection big" 1000 rows ...
anyone me out tiny bit forever thankful!
many in advance!
you have change sheetname name of sheet data is, in line :
set ws = thisworkbook.sheets("sheetname") and put desired output in new sheet :
sub testfranklucas() dim long dim lastrow long dim ws worksheet dim wsnew worksheet dim data() variant set ws = thisworkbook.sheets("sheetname") lastrow = lastrow_1(ws) redim data(1 3, 1 1) = 1 lastrow step 6 ws data(1, ubound(data, 2)) = .cells(i, 1).offset(3, 0) data(2, ubound(data, 2)) = .cells(i, 1).offset(4, 0) data(3, ubound(data, 2)) = .cells(i, 1).offset(5, 0) redim preserve data(lbound(data, 1) ubound(data, 1), lbound(data, 2) ubound(data, 2) + 1) end 'ws next redim preserve data(lbound(data, 1) ubound(data, 1), lbound(data, 2) ubound(data, 2) - 1) set wsnew = thisworkbook.sheets.add 'wsnew.range("a1").resize(ubound(data, 2), ubound(data, 1)).value = application.transpose(data) = lbound(data, 2) ubound(data, 2) j = lbound(data, 1) ubound(data, 1) wsnew .cells(i, j).value = data(j, i) end 'wsnew next j next end sub public function lastrow_1(ws worksheet) double ws if application.worksheetfunction.counta(.cells) <> 0 lastrow_1 = .cells.find(what:="*", _ after:=.range("a1"), _ lookat:=xlpart, _ lookin:=xlformulas, _ searchorder:=xlbyrows, _ searchdirection:=xlprevious, _ matchcase:=false).row else lastrow_1 = 1 end if end end function 
Comments
Post a Comment