excel - Update values of 2 Cells at the same time -
i have 7 worksheets containg information room project university, need search each sheet information, if computer pool or not. want copy pools worksheet , can update information sheet , auto updates orignal worksheet.
my main problem don't know how update function called. attached code in bottom copies rooms dedicated sheet. in advance
option explicit sub start() dim suche string dim blatt1 string dim blatt2 string dim blatt3 string dim blatt4 string dim blatt5 string dim blatt6 string dim blatt7 string dim result string blatt1 = "1. stock mzg" blatt2 = "5. stock mzg" blatt3 = "6. stock mzg" blatt4 = "7. stock mzg" blatt5 = "8. stock mzg" blatt6 = "1. stock oec" blatt7 = "2. stock oec" suche = "poolraum" if len(suche) result = "es wurde(n) " & auswahlkopieren(suche, true, blatt1) & " zeile(n) aus '" & blatt1 & "' kopiert!" result = result & vbcrlf & "es wurde(n) " & auswahlkopieren(suche, true, blatt2) & " zeile(n) aus '" & blatt2 & "' kopiert!" result = result & vbcrlf & "es wurde(n) " & auswahlkopieren(suche, true, blatt3) & " zeile(n) aus '" & blatt3 & "' kopiert!" result = result & vbcrlf & "es wurde(n) " & auswahlkopieren(suche, true, blatt4) & " zeile(n) aus '" & blatt4 & "' kopiert!" result = result & vbcrlf & "es wurde(n) " & auswahlkopieren(suche, true, blatt5) & " zeile(n) aus '" & blatt5 & "' kopiert!" result = result & vbcrlf & "es wurden(n) " & auswahlkopieren(suche, true, blatt6) & " zeile(n) aus '" & blatt6 & "' kopiert!" result = result & vbcrlf & "es wurde(n) " & auswahlkopieren(suche, true, blatt7) & " zeile(n) aus '" & blatt7 & "' kopiert!" msgbox (result) end if end sub function auswahlkopieren(suchstr string, optional ganz boolean = false, optional arbeitsblattname string) integer dim wsq worksheet dim wsz worksheet dim suchcolrng range dim frng range dim crng range dim crangecustom range dim firstadr string dim carr variant set wsq = worksheets(arbeitsblattname) set suchcolrng = wsq.range("e:e") set crangecustom = wsq.range("a:g") set wsz = worksheets("poolräume") suchcolrng if ganz set frng = .find(suchstr, lookin:=xlvalues, lookat:=xlwhole) else set frng = .find(suchstr, lookin:=xlvalues, lookat:=xlpart) end if if not frng nothing firstadr = frng.address if crng nothing set crng = wsq.rows(frng.row) else set crng = union(wsq.rows(frng.row), crng) 'msgbox ("wsq.rows(frng.row): " + wsq.rows(frng.row)) end if set frng = .findnext(frng) loop while not frng nothing , frng.address <> firstadr end if end if not crng nothing set crng = intersect(crng, crangecustom) crng.copy wsz.cells(wsz.cells(wsz.rows.count, suchcolrng.column).end(xlup).row + 1, 1).pastespecial xlpastevalues application.cutcopymode = false auswahlkopieren = crng.cells.count / crng.rows(1).cells.count msgbox ("crng.cells.count: " & crng.cells.count & " crng.rows(1).cells.count: " & crng.rows(1).cells.count) else auswahlkopieren = 0 end if end function function wsexists(byval wsname string) boolean dim ws worksheet each ws in worksheets if ws.name = wsname wsexists = true exit end if next end function
i don't see other way rather copy other sheet mentioned not pool information, reference pool taken (sheet, cell). after that, can make separate macro put changes because know taken. hope helps.
Comments
Post a Comment