Sub Datainsert () Dim R1 As Integer, r2 As Integer, I As Integer, J As Integer, FindRow as Integer, findmonth as Int Eger, tday as Integer findmonth= Range ("H1") Set Source= Worksheets ("Total Weekly Schedule") Set T=ActiveSheet R1= Source.range ("a65536"). End (Xlup). Row'Start LoopFor i=2To R1 XM= Source.cells (I,8) KC= Source.cells (I,7) JC= Source.cells (I,6) RQ= Source.cells (I,4) BC= Source.cells (I,3) DD= Source.cells (I,9) 'Compare DatesIf Format (RQ,"M") =Findmonth then R2= T.range ("c65536"). End (Xlup). Row If (R2<3) Then r2 =3Tday= Format (RQ,"D") +7 'Move back 7 cellsFindRow=0For J=3to R2 If T.cells (J,3) =XM then FindRow=J Exit for End if Next if (FindRow
>0) Then'Findt.cells (FindRow, Tday)= Cells (FindRow, Tday) &" "&JC Else'not found directly addT.cells (R2+1,3) =XM t.cells (R2+1,4) =KC T.cells (R2+1,6) =BC T.cells (R2+1, the) =DD T.cells (R2+1, tday) =JC End If End If NextEnd Sub
Vba-from weekly timetable statistics festival