i have workbook called 'evaluationlog.xlsm' , need transfer specific cells (not whole row) first worksheet existing workbook called 'indicatorlog.xlsm' located in same directory. target worksheet first one. i'm trying have macro hosted in 'indicatorlog' workbook.
specific cells in each row source copied if contents in column 'o' 'no' or if contents of column 'j' 'initial'. actual source data starts on row 8 , target range starts on row 8.
i'm having 2 issues. first 1 i'm getting error 'application-defined or object-defined error (1004)' @ first line i'm trying copy cells.
this line: targetsheet.range("a" & nrow).value = workbk.activesheet.range(“a” & i).value
the second issue when have source workbook open, warning trying open again though have function try avoid that. :(
i assigned macro form button. appreciated! :)
here 2 excel files:
here's code:
sub mergefromlog() dim targetsheet worksheet dim nrow long dim sourcefilename string dim workbk workbook dim lastrow integer, integer, erow integer ' set destination file. set targetsheet = activeworkbook.worksheets(1) ' set source file. sourcefilename = activeworkbook.path & "\2015-2016 evaluation log.xlsm" ' nrow keeps track of insert new rows in destination workbook. nrow = 8 ' open source workbook in folder if checkfileisopen(sourcefilename) = false set workbk = workbooks.open(sourcefilename) else set workbk = workbooks(sourcefilename) end if lastrow = workbk.activesheet.cells(rows.count, "a").end(xlup).row = 8 lastrow if workbk.activesheet.range("o" & i) = "no" or workbk.activesheet.range("j" & i) = "initial" ' copy student name targetsheet.range("a" & nrow).value = workbk.activesheet.range(“a” & i).value ' copy dob targetsheet.range("b" & nrow).value = workbk.activesheet.range(“c” & i).value ' copy id# targetsheet.range("c" & nrow).value = workbk.activesheet.range(“d” & i).value ' copy consent day targetsheet.range("d" & nrow).value = workbk.activesheet.range(“l” & i).value ' copy report day targetsheet.range("e" & nrow).value = workbk.activesheet.range(“n” & i).value ' copy fie within district timelines? targetsheet.range("f" & nrow).value = workbk.activesheet.range(“o” & i).value ' copy qualified? targetsheet.range("h" & nrow).value = workbk.activesheet.range(“a” & i).value ' copy primary eligibility targetsheet.range("i" & nrow).value = workbk.activesheet.range(“u” & i).value ' copy ard date targetsheet.range("j" & nrow).value = workbk.activesheet.range(“r” & i).value ' copy ard within district timelines? targetsheet.range("k" & nrow).value = workbk.activesheet.range(“s” & i).value ' copy ethnicity targetsheet.range("m" & nrow).value = workbk.activesheet.range(“f” & i).value ' copy hisp? targetsheet.range("n" & nrow).value = workbk.activesheet.range(“g” & i).value ' copy diag/lssp targetsheet.range("o" & nrow).value = workbk.activesheet.range(“x” & i).value nrow = nrow + 1 end if next end sub function checkfileisopen(chksumfile string) boolean on error resume next checkfileisopen = ucase(workbooks(chksumfile).name) ucase(chksumfile) on error goto 0 end function
you can take advantage of used resume error control.
sub mergefromlog2() dim sourcesheet worksheet, targetsheet worksheet dim sourcefilename string dim lastrow long, long, nrow long ' set destination file. set targetsheet = thisworkbook.worksheets(1) nrow = targetsheet.cells(rows.count, 1).end(xlup).row + 1 ' set source file. on error goto checkwbisopen sourcefilename = thisworkbook.path & "\2015-2016 evaluation log.xlsm" 'try work on if open. if closed error thrown , opened , control returned here set sourcesheet = workbooks(trim(right(replace(sourcefilename, "\", space(99)), 99))).worksheets(1) on error goto 0 sourcesheet debug.print .name lastrow = .cells(rows.count, "a").end(xlup).row = 8 lastrow if .range("o" & i) = "no" or .range("j" & i) = "initial" ' copy student name targetsheet.range("a" & nrow).value = .range("a" & i).value ' copy dob targetsheet.range("b" & nrow).value = .range("c" & i).value ' copy id# targetsheet.range("c" & nrow).value = .range("d" & i).value ' copy consent day targetsheet.range("d" & nrow).value = .range("l" & i).value ' copy report day targetsheet.range("e" & nrow).value = .range("n" & i).value ' copy fie within district timelines? targetsheet.range("f" & nrow).value = .range("o" & i).value ' copy qualified? targetsheet.range("h" & nrow).value = .range("a" & i).value ' copy primary eligibility targetsheet.range("i" & nrow).value = .range("u" & i).value ' copy ard date targetsheet.range("j" & nrow).value = .range("r" & i).value ' copy ard within district timelines? targetsheet.range("k" & nrow).value = .range("s" & i).value ' copy ethnicity targetsheet.range("m" & nrow).value = .range("f" & i).value ' copy hisp? targetsheet.range("n" & nrow).value = .range("g" & i).value ' copy diag/lssp targetsheet.range("o" & nrow).value = .range("x" & i).value nrow = nrow + 1 end if next application.displayalerts = false .parent.close false end goto safe_exit checkwbisopen: = + 1 if > 1 'tried once , failed - not keep trying open doesn't want opened debug.print "unable open: " & sourcefilename exit sub end if workbooks.open filename:=sourcefilename, readonly:=true resume '<- sends control line threw error safe_exit: set sourcesheet = nothing set targetsheet = nothing application.displayalerts = true end sub the error trapping resume negates need function.
Comments
Post a Comment