excel vba - VBA Search for Header, Copy, and Paste all data below header -


i need create macro searches column header name, finds column, copies data below it, , pastes cell a3 of worksheet.

for example, on sheet 1

+-----+------+-------+ | row | part | price | +-----+------+-------+ |   1 | x    |     5 | |   2 | y    |     6 | |   3 | z    |     7 | +-----+------+-------+ 

so, macro search "part", copy x, y, , z (the number of rows can change, cant copy b2:b4), , paste a3 of sheet 2. then, search price, copy 5, 6, , 7, , paste b3 of sheet 2. etc etc

here have far:

sub cleanup()      sheets("sheet1").select      pn = worksheetfunction.match("part_no", rows("1:1"), 0)      sheets("sheet1").columns(pn).copy _               destination:=sheets("sheet2").range("a3")  end sub 

thank you!

something this:

sub cleanup()      dim arrcols, shtsrc worksheet, rngdest range, hdr, pn      arrcols = array("part_no", "qty", "units") '<< column headers copied      set shtsrc = sheets("sheet1")              '<< sheet copy     set rngdest = sheets("sheet2").range("a3") '<< starting point pasting      'loop on columns     each hdr in arrcols          pn = application.match(hdr, shtsrc.rows(1), 0)          if not iserror(pn)             '##edit here##             shtsrc.range(shtsrc.cells(2, pn), _                          shtsrc.cells(rows.count, pn).end(xlup)).copy rngdest             '/edit         else             rngdest.value = hdr             rngdest.interior.color = vbred '<< flag missing column         end if          set rngdest = rngdest.offset(0, 1)     next hdr  end sub 

Comments

Popular posts from this blog

android - InAppBilling registering BroadcastReceiver in AndroidManifest -

python Tkinter Capturing keyboard events save as one single string -

sql server - Why does Linq-to-SQL add unnecessary COUNT()? -