my code below shows how filter range depends on value of column. whenever tried 2nd case , 3rd case getting runtime error.
hi jeeped, kindly review below edited code:
private sub cmdatsend_click() '************************************************************** 'copy data '************************************************************** dim myproject string, scriteria string myproject = inputbox("on sheet wish transfer these data?", "daily alarms tracker", "ono, infinity, or net brazil?") sheets("daily alarms tracker") scriteria = vbnullstring select case myproject case "infinity", "infinity", "infinity", "inf", "inf" scriteria = "infinity" case "ono", "ono", "ono" scriteria = "ono" case "net brazil", "net", "net brazil", "net", "net brazil", "net brazil" scriteria = "net brazil" end select if cbool(len(scriteria)) .range("c7:k18") .autofilter .autofilter field:=1, criteria1:=scriteria '.offset(1, 0).resize(.rows.count - 1, .columns.count).select if cbool(application.subtotal(103, .offset(1, 0).resize(.rows.count - 1, .columns.count))) .offset(1, 1).resize(.rows.count - 1, .columns.count - 1).copy else debug.print "nothing matches" end if end end if end '******************************************************************* 'paste data '******************************************************************* dim atwb workbook set atwb = workbooks.open("https://ts.company.com/sites/folder1/folder2/01%20project%20documentations/daily%20alarms%20tracker/daily_alarms_tracker.xlsx") set atwb = activeworkbook select case scriteria case "infinity" dim irow long sheets("infinity") erow = .cells(rows.count, "b:b").end(xlup).row + 1 .cells(irow, "a").pastespecial xlpastevaluesandnumberformats end case "ono" dim orow long sheets("ono") erow = .cells(rows.count, "b:b").end(xlup).row + 1 .cells(orow, "a").pastespecial xlpastevaluesandnumberformats end case "net" dim nrow long sheets("net") erow = .cells(rows.count, "b:b").end(xlup).row + 1 .cells(nrow, "a").pastespecial xlpastevaluesandnumberformats end end select end sub
i've added variable store criteria select case , copied values clipboard when there filtered records. .copy on filtered rows copy visible ones.
private sub cmdatsend_click() dim myproject string, scriteria string, stargetws string dim wb workbook, atwb workbook myproject = inputbox("on sheet wish transfer these data?", "daily alarms tracker", "ono, infinity, or net brazil?") 'open target wb direct use later set wb = activeworkbook set atwb = workbooks.open("https://ts.company.com/sites/folder1/folder2/01%20project%20documentations/daily%20alarms%20tracker/daily_alarms_tracker.xlsx") wb.sheets("daily alarms tracker") scriteria = vbnullstring: stargetws = vbnullstring select case myproject case "infinity", "infinity", "infinity", "inf", "inf" scriteria = "infinity" stargetws = "infinity" case "ono", "ono", "ono" scriteria = "ono" stargetws = "ono" case "net brazil", "net", "net brazil", "net", "net brazil", "net brazil" scriteria = "net brazil" stargetws = "net" end select if cbool(len(scriteria)) .range("c7:k18") .autofilter .autofilter field:=1, criteria1:=scriteria 'with .offset(1,0).resize(.rows.count-1, .columns.count) if cbool(application.subtotal(103, .offset(1, 0).resize(.rows.count - 1, .columns.count))) .offset(1, 1).resize(.rows.count - 1, .columns.count - 1).copy _ destination:=atwb.sheets(stargetws).cells(rows.count, 2).end(xlup).offset(1, 0) else debug.print "nothing matches" end if end end if end 'you close daily_alarms_tracker workbook here 'atwb.close savechanges:=true set atwb = nothing set wb = nothing end sub i'm not sure want values @ end of private sub there may rows copied clipboard. error control in case there no records may appropriate. seem scriteria holds name of destination worksheet.
