1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
|
Dim bsum As Integer, lRowType(15), lrowtypeValue(15), Summary1(15), lsummary1value(15), _
lTeam1(15), lTeam1value(15), lresponsible1(15), lresponsible1value(15), _
ldatewish1(15), ldatewish1value(15), lstatus1(15), lstatus1value(15), ltest(15)
Dim bsum2 As Integer, ltest2(15)
Dim bsum3 As Integer, ltest3(15)
bsum2 = 1
bsum3 = 1
For bsum = 1 To 15
Sheet1.Activate
lRowType(bsum) = ActiveSheet.range("COL_ROWTYPE").Column
lrowtypeValue(bsum) = ActiveSheet.range(Number2Char(lRowType(bsum)) & lrow + bsum).Value
ltest(bsum) = "rowadelete" 'Variable qui va ajouter "rowadelete" dans la column "rowdelete"
ltest2(bsum2) = "rowadelete"
ltest3(bsum3) = "rowadelete"
If lrowtypeValue(bsum) <> "P" Then
Summary1(bsum) = ActiveSheet.range("COL_Summary").Column
lsummary1value(bsum) = ActiveSheet.range(Number2Char(Summary1(bsum)) & lrow + bsum).Value
lTeam1(bsum) = ActiveSheet.range("COL_ASSIGNEE_DEPT").Column
lTeam1value(bsum) = ActiveSheet.range(Number2Char(lTeam1(bsum)) & lrow + bsum).Value
lresponsible1(bsum) = ActiveSheet.range("COL_ASSIGNEE").Column
lresponsible1value(bsum) = ActiveSheet.range(Number2Char(lresponsible1(bsum)) & lrow + bsum).Value
ldatewish1(bsum) = ActiveSheet.range("COL_WISHDATE").Column
ldatewish1value(bsum) = ActiveSheet.range(Number2Char(ldatewish1(bsum)) & lrow + bsum).Value
lstatus1(bsum) = ActiveSheet.range("COL_STATUS").Column
lstatus1value(bsum) = ActiveSheet.range(Number2Char(lstatus1(bsum)) & lrow + bsum).Value
On Error GoTo passealasuite
nbre_mois = ((Year(Date) - Year(ldatewish1value(bsum))) * 12) + Month(Date) - Month(ldatewish1value(bsum))
nbre_mois = nbre_mois
On Error GoTo passealasuite
If lsummary1value(bsum) = Empty Or lsummary1value(bsum) = "" Then lsummary1value(bsum) = " -- "
If lTeam1value(bsum) = Empty Or lTeam1value(bsum) = "" Then lTeam1value(bsum) = " -- "
If lresponsible1value(bsum) = Empty Or lresponsible1value(bsum) = "" Then lresponsible1value(bsum) = " -- "
If ldatewish1value(bsum) = Empty Or ldatewish1value(bsum) = "" Then ldatewish1value(bsum) = " -- "
If lstatus1value(bsum) = Empty Or lstatus1value(bsum) = "" Then lstatus1value(bsum) = " -- "
If ldatewish1value(bsum) = " -- " Then GoTo dt 'pas de date wish goto <1 mois
If nbre_mois < 1 Then
dt:
Application.ScreenUpdating = False
Sheet9.Activate
Sheet9.range("Actionplan1").Offset(1, 0).Select
Selection.Insert
Sheet9.range("Actionplan1").Select
Selection.Copy
Sheet9.range("Actionplan1").Offset(1, 0).Select
ActiveSheet.Paste
Sheet9.range("shorttermactions1").Offset(1) = lsummary1value(bsum)
Sheet9.range("shorttermteam1").Offset(1) = lTeam1value(bsum)
Sheet9.range("shorttermresponsible1").Offset(1) = lresponsible1value(bsum)
Sheet9.range("shorttermduedate1").Offset(1) = ldatewish1value(bsum)
Sheet9.range("shorttermstatus1").Offset(1) = lstatus1value(bsum)
Sheet9.range("shorttermstatus1").Offset((bsum), 3) = ltest(bsum) ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
Application.ScreenUpdating = False
GoTo passealasuite
ElseIf nbre_mois >= 1 And nbre_mois < 3 Then
Application.ScreenUpdating = False
Sheet9.Activate
Sheet9.range("Actionplan2").Offset(1, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheet9.range("Actionplan2").Select
Selection.Copy
Sheet9.range("Actionplan2").Offset(1, 0).Select
ActiveSheet.Paste
ltest2(bsum2) = "rowadelete"
Sheet9.range("shorttermactions2").Offset(1) = lsummary1value(bsum)
Sheet9.range("shorttermteam2").Offset(1) = lTeam1value(bsum)
Sheet9.range("shorttermresponsible2").Offset(1) = lresponsible1value(bsum)
Sheet9.range("shorttermduedate2").Offset(1) = ldatewish1value(bsum)
Sheet9.range("shorttermstatus2").Offset(1) = lstatus1value(bsum)
Sheet9.range("shorttermstatus2").Offset((bsum2), 3) = ltest2(bsum2) ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
bsum2 = bsum2 + 1
Application.ScreenUpdating = False
GoTo passealasuite
ElseIf nbre_mois >= 3 Then
Application.ScreenUpdating = False
Sheet9.Activate
Sheet9.range("Actionplan3").Offset(1, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheet9.range("Actionplan3").Select
Selection.Copy
Sheet9.range("Actionplan3").Offset(1, 0).Select
ActiveSheet.Paste
ltest3(bsum3) = "rowadelete"
Sheet9.range("shorttermactions3").Offset(1) = lsummary1value(bsum)
Sheet9.range("shorttermteam3").Offset(1) = lTeam1value(bsum)
Sheet9.range("shorttermresponsible3").Offset(1) = lresponsible1value(bsum)
Sheet9.range("shorttermduedate3").Offset(1) = ldatewish1value(bsum)
Sheet9.range("shorttermstatus3").Offset(1) = lstatus1value(bsum)
Sheet9.range("shorttermstatus3").Offset((bsum3), 3) = ltest3(bsum3) ' ligne qui ajoute le text "rowadelete" dans la column "rowdelete"
bsum3 = bsum3 + 1
Application.ScreenUpdating = False
GoTo passealasuite
End If 'fin de la condition date
passealasuite:
Else ' si lrowtypeValue(bsum) = "P"
lsummary1value(bsum) = ""
lTeam1value(bsum) = ""
lresponsible1value(bsum) = ""
ldatewish1value(bsum) = ""
lstatus1value(bsum) = ""
GoTo lasuite
End If
Next bsum
lasuite: |
Partager