petites difficultés

[boby]

Bonjour à tous

voila un petit probleme de macro que je n'arrive pas à résoudre car je suis trop nul
je ne comprends pas pourquoi ma macro ne s'applique pas partout sur mon fichier

ce que je vousdrai pouvoir faire en plus sur ce fichier mais que je n'arrive pas est en couleur 3 fois pour exemple mais devrai s'appliquer sur tout le fichier

je souhaiterai ensuite masquer les colonnes N O P

je sais que vous etes les meilleurs, c'est pour cela que je fais appel à vous
merci de votre aide

voici ma modeste macro et mon bout de fichier

Sub FAILS_MONITOR_GERMAN_MARKET()

Dim I As Integer
Dim code As String, debut1 As String, debut2 As String

Application.ScreenUpdating = False
Range("B:B,E:E,I:I,K:K,N:N").Select
ActiveWindow.SmallScroll ToRight:=8
Range("B:B,E:E,I:I,K:K,N:N,R:R,T:T").Select
Selection.delete Shift:=xlToLeft

' critères
For I = 2 To Range("A65536").End(xlUp).Row
If Not InStr(1, Cells(I, 4).Value, "EBBP", vbTextCompare) = 0 And IsEmpty(Cells(I, 5).Value) = True Then Cells(I, 6).Value = "POSITION EUROCLEAR"
If Not InStr(1, Cells(I, 4).Value, "EBTY", vbTextCompare) = 0 And IsEmpty(Cells(I, 5).Value) = True Then Cells(I, 6).Value = "POSITION TRIPARTY"
If Cells(I, 1).Value = "Trade" And Cells(I + 1, 1).Value = "Position" Then Rows(I + 1 & ":" & I + 1).Insert Shift:=xlDown
If Cells(I, 6).Value = "POSITION TRIPARTY" And IsEmpty(Cells(I + 1, 6)) = False Then Rows(I + 1 & ":" & I + 1).Insert Shift:=xlDown
Next I

For I = 2 To Range("A65536").End(xlUp).Row

If Cells(I, 6).Value = "POSITION EUROCLEAR" Then ActiveCell.FormulaR1C1 = "=RC[7]"
If Cells(I, 6).Value = "POSITION TRIPARTY" Then ActiveCell.FormulaR1C1 = "=RC[7]"
Range("G7").Select

Next I
'mise en gras des colonnes
Range("A:B,F:F,H:H,I:I,K:K").Font.Bold = True

'séparateur de milliers
columns("G:G").NumberFormat = "#,##0"
columns("H").NumberFormat = "#,##0.00 _€"

'centrer les celule, fond blanc
With Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 2
End With

'premiere ligne plus large, en gras, et couleur de celule bleu turquoise
With Rows("1:1")
.Font.Bold = True
.RowHeight = 40
.Interior.ColorIndex = 34
End With

'zoom à 80%, ajustement automatique ligne colonne
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
Range("F15").Select

'mise en page, paysage, ajustée 1 page en largeur et 100 pages en longeurs, 0 marge droite gauche,
'centré vertical et horizontal, en-tete et pieds de page renseignés
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.CenterHeader = "&""Arial,Gras""&11 FAILS MONITOR GERMAN MARKET"
.RightHeader = "&D"
.LeftFooter = "&T"
.RightFooter = "&""Arial,Gras""&BOBY"
End With
Range("F15").Select

'zone d'impression jusqu'à la dernière ligne non vide
Dim DerLig As Integer
Dim DerCol As Integer
DerLig = Range("a65536").End(xlUp).Row
DerCol = Range("h40").End(xlToRight).Column
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(DerLig, DerCol)).Address

'fenetres / reorganiser / Horizontal
Windows.Arrange ArrangeStyle:=xlHorizontal
Application.ScreenUpdating = True

End Sub

 

[Bebere]

Re : petites difficultés

bonsoir Boby
un essai de réponse

Sub FAILS_MONITOR_GERMAN_MARKET()

Dim I As Integer
Dim code As String, debut1 As String, debut2 As String
Dim DerLig As Integer
Dim DerCol As Integer

Application.ScreenUpdating = False


'Range("B:B,E:E,I:I,K:K,N:N").Select
'ActiveWindow.SmallScroll ToRight:=8
'Range("B:B,E:E,I:I,K:K,N:N,R:R,T:T").Select
'Selection.Delete Shift:=xlToLeft
Sheets("APRES").Activate
' critères
For I = 2 To Range("A65536").End(xlUp).Row
If Cells(I, 4).Value = "EBBP" And Cells(I, 5).Value = "" Then _
Cells(I, 6).Value = "POSITION EUROCLEAR"
If Cells(I, 4).Value = "EBTY" And _
Cells(I, 5).Value = "" Then Cells(I, 6).Value = "POSITION TRIPARTY"
If Cells(I, 1).Value = "Trade" And Cells(I + 1, 1).Value = "Position" Then _
Rows(I + 1).Insert Shift:=xlDown
If Cells(I, 6).Value = "POSITION TRIPARTY" And Cells(I + 1, 6) = "" _
Then Rows(I + 1).Insert Shift:=xlDown
Next I

For I = 2 To Range("A65536").End(xlUp).Row

If Cells(I, 6).Value = "POSITION EUROCLEAR" Then _
Cells(I, 7).Value = Cells(I, 14).Value
If Cells(I, 6).Value = "POSITION TRIPARTY" Then _
Cells(I, 7).Value = Cells(I, 14).Value
'Range("G7").Select

Next I
'mise en gras des colonnes
DerLig = Range("a65536").End(xlUp).Row
Range("A2:B" & DerLig).Font.Bold = True
Range("F2:F" & DerLig).Font.Bold = True
Range("H2:H" & DerLig).Font.Bold = True
Range("I2:I" & DerLig).Font.Bold = True
Range("K2:K" & DerLig).Font.Bold = True

'séparateur de milliers
Range("G2:G" & DerLig).NumberFormat = "#,##0"
Range("H2:H" & DerLig).NumberFormat = "#,##0.00 _€"

'centrer les cellules, fond blanc
With Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 2
End With

'premiere ligne plus large, en gras, et couleur de celule bleu turquoise
With Range("A1:R1")
.Font.Bold = True
.RowHeight = 40
.Interior.ColorIndex = 34
End With

'zoom à 80%, ajustement automatique ligne colonne
ActiveWindow.Zoom = 80
'Cells.Select
Columns("A:R").AutoFit
'Range("F15").Select

'mise en page, paysage, ajustée 1 page en largeur et 100 pages en longeurs, 0 marge droite gauche,
'centré vertical et horizontal, en-tete et pieds de page renseignés
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.CenterHeader = "&""Arial,Gras""&11 FAILS MONITOR GERMAN MARKET"
.RightHeader = "&D"
.LeftFooter = "&T"
.RightFooter = "&""Arial,Gras""&BOBY"
End With
'Range("F15").Select

'zone d'impression jusqu'à la dernière ligne non vide
DerLig = Range("a65536").End(xlUp).Row
DerCol = Range("h40").End(xlToRight).Column
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(DerLig, DerCol)).Address

'fenetres / reorganiser / Horizontal
Windows.Arrange ArrangeStyle:=xlHorizontal
Application.ScreenUpdating = True

End Sub

à bientôt

 

[Gorfael]

Re : petites difficultés

Salut boby, et les autres

Citation pour ton code
Code pour mes modifs

Sub FAILS_MONITOR_GERMAN_MARKET()

Dim I As Integer
Dim code As String, debut1 As String, debut2 As String

Application.ScreenUpdating = False
Range("B:B,E:E,I:I,K:K,N:N").Select
ActiveWindow.SmallScroll ToRight:=8
Range("B:B,E:E,I:I,K:K,N:N,R:R,T:T").Select
Selection.delete Shift:=xlToLeft

Moi, je verrais plutôt

Sub FAILS_MONITOR_GERMAN_MARKET()

Dim I As Integer
Dim code As String, debut1 As String, debut2 As String
Dim DerLig As Integer
Dim DerCol As Integer

    Application.ScreenUpdating = False
    Range("B:B,E:E,I:I,K:K,N:N,R:R,T:T").delete Shift:=xlToLeft

supprimer les colonnes B, E, I, K, N, R, T
Toutes les déclarations sont au début. ça ne change rien au programme, mais c'est mieux et si tu veux modifier un nom, ça t'évite de rechercher. De plus ça te permet de retrouver un nom, ou d'écraser une variable

' critères
For I = 2 To Range("A65536").End(xlUp).Row
If Not InStr(1, Cells(I, 4).Value, "EBBP", vbTextCompare) = 0 And IsEmpty(Cells(I, 5).Value) = True Then Cells(I, 6).Value = "POSITION EUROCLEAR"
If Not InStr(1, Cells(I, 4).Value, "EBTY", vbTextCompare) = 0 And IsEmpty(Cells(I, 5).Value) = True Then Cells(I, 6).Value = "POSITION TRIPARTY"
If Cells(I, 1).Value = "Trade" And Cells(I + 1, 1).Value = "Position" Then Rows(I + 1 & ":" & I + 1).Insert Shift:=xlDown
If Cells(I, 6).Value = "POSITION TRIPARTY" And IsEmpty(Cells(I + 1, 6)) = False Then Rows(I + 1 & ":" & I + 1).Insert Shift:=xlDown
Next I

' critères
For I = Range("A65536").End(xlUp).Row to 2 step -1
    If Not InStr(1, Range("D" & i), "EBBP", vbTextCompare) = 0 And IsEmpty(Range("E" & i)) = True Then Range("F" & i)= "POSITION EUROCLEAR"
    If Not InStr(1, Range("D" & i), "EBTY", vbTextCompare) = 0 And IsEmpty(Range("E" & i)) = True Then Range("F" & i) = "POSITION TRIPARTY"
    If range("A" & i) = "Trade" And range("A" & i+1) = "Position" Then Rows(I + 1).Insert Shift:=xlDown
    If range("F" & i) = "POSITION TRIPARTY" And IsEmpty(range("F" & I + 1)) = False Then Rows(I + 1).Insert Shift:=xlDown
Next I

Fait un essai de cette macro sur une feuille de Test avec A1:A10 = "A"
Sub Macro_Test()
dim X as long
for X=1 to range("A65536").End(xlup).row
IF Range("A" & x)<>"" then Rows(X+1).insert shift :=XlDown
next X
end sub
C'est ton code, en simplifié. T'utilises Cells, moi je préfères range, tant que je n'utilise pas un compteur sur les colonnes, parce que je sais quelle est la colonne"DP" alors que la colonne 115, il faut que je cherche.. Ton t'essais ce code et s'il était bon, tu auaris une ligne vide intercalée entre les ligne comportant les A de 1 à 19. et ce n'est pas le cas, parce que la valeur max de X (de i dans ton code) est fixée au premier passage sur le code For
Donc, quand tu fais des insertions, parts de la dernière en remontant(décrémentation : step -1)
pour vérifier, tu essaies sur la même base (A1:A10 = A)
Sub Macro_Test()
dim X as long
for X=range("A65536").End(xlup).row to 1 step -1
IF Range("A" & x)<>"" then Rows(X+1).insert shift :=XlDown
next X
end sub

For I = 2 To Range("A65536").End(xlUp).Row

If Cells(I, 6).Value = "POSITION EUROCLEAR" Then ActiveCell.FormulaR1C1 = "=RC[7]"
If Cells(I, 6).Value = "POSITION TRIPARTY" Then ActiveCell.FormulaR1C1 = "=RC[7]"
Range("G7").Select

Next I

For I = 2 To Range("A65536").End(xlUp).Row
 
    If Range("F" & i)= "POSITION EUROCLEAR" or _
          Range("F" & i) = "POSITION TRIPARTY" Then ActiveCell.FormulaR1C1 = "=RC[7]"
    Range("G7").Select

Next I

Je ne comprends pas ce que tu veux faire avec ce morceau de code
à part si la ligne 2 remplit la condition de test, dans ce cas, la formule va se loger dans la dernière ligne inserée, sinon, comme c'est la cellule G7 qui est active, tu y colles ta formule autant de fois qu'il y a de test vrai

'mise en gras des colonnes
Range("A:B,F:F,H:H,I:I,K:K").Font.Bold = True

'séparateur de milliers
columns("G:G").NumberFormat = "#,##0"
columns("H").NumberFormat = "#,##0.00 _€"

'centrer les celule, fond blanc
With Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 2
End With

Rien à dire, sauf peut-être
columns("G:G").NumberFormat = "#,##0" =>columns("G").NumberFormat = "#,##0"

'premiere ligne plus large, en gras, et couleur de celule bleu turquoise
With Rows("1:1")
.Font.Bold = True
.RowHeight = 40
.Interior.ColorIndex = 34
End With

remplace With Rows("1:1") par With Rows(1)

zoom à 80%, ajustement automatique ligne colonne
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
Range("F15").Select

Supprime ta sélection de F15, ici, ça sert à rien et tu la sélectionnes plus tard

'mise en page, paysage, ajustée 1 page en largeur et 100 pages en longeurs, 0 marge droite gauche,
'centré vertical et horizontal, en-tete et pieds de page renseignés
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.CenterHeader = "&""Arial,Gras""&11 FAILS MONITOR GERMAN MARKET"
.RightHeader = "&D"
.LeftFooter = "&T"
.RightFooter = "&""Arial,Gras""&BOBY"
End With
Range("F15").Select

F15 est bien sélectionnée. J'ai pas vérifié ta mise en page

'zone d'impression jusqu'à la dernière ligne non vide
Dim DerLig As Integer
Dim DerCol As Integer
DerLig = Range("a65536").End(xlUp).Row
DerCol = Range("h40").End(xlToRight).Column
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(DerLig, DerCol)).Address

'zone d'impression jusqu'à la dernière ligne non vide
DerLig = Range("a65536").End(xlUp).Row
DerCol = Range("h40").End(xlToRight).Column
ActiveSheet.PageSetup.PrintArea = Range("A1:" & Cells(DerLig, DerCol).address).address

'fenetres / reorganiser / Horizontal
Windows.Arrange ArrangeStyle:=xlHorizontal
Application.ScreenUpdating = True

End Sub

Certains passages me semblent obscures. Sinon, l'ensemble me rappelle le code issu des macros automatiques, ce qui fait que certaines instructions sont inutikes.
Comme tout code, il est personnel, dépend de celui qui le crée et à part certaines erreurs, où on peut aider, la préférence d'une instruction par rapport à une autre est le plus souvent subjective.
Par exemple, je préfère Range à Cells ou for next à Do Loop, mais j'utilise l'une et l'autre quand j'y ai avantage.

Bon, j'espère que je t'ai un peu aider avec ma "critique" sinon, tant pis

A+

NOTA je ne me moque pas de toi (quoique), ni ne dénigre ton travail en le "critiquant". J'expose seulement ce que je crois comprendre et comment, moi, je ferais

 

[boby]

Re : petites difficultés

bonjour Bebere, bonjour Gorfael
bonjour le forum

merci à tous les deux pour les efforts que vous avez fait pour m'apporter une solution à mon probleme,

des deux solution qui m'ont été proposés, je penche plutot pour celles de Gorfael car elle s'applique à toute la feuille

cependant il persiste certains manques:
- les manques sont représenté par les lignes (et cellules) de couleurs jaune
- je souhaiterai ensuite masquer les lignes en N et O
- pour ce qui est de la mise en page je m'en charge

je part de l'onglet DEPART

merci de votre aide

 

[boby]

Re : petites difficultés

oups
il semble que j'ai oublié le fichier
ps: j'accepte les critique car en effet je ne suis pas un programmeur
et je ne connais pas grands chose en vba
il est vrai que je m'aide beaucoup de l'enregistreur

merci

 

[boby]

Re : petites difficultés

voici la macro telle qu'elle est pour le moment

Sub TEST()

Dim I As Integer
Dim code As String, debut1 As String, debut2 As String
Dim DerLig As Integer
Dim DerCol As Integer

Application.ScreenUpdating = False
Range("B:B,E:E,I:I,K:K,N:N,R:R,T:T,W:W").delete Shift:=xlToLeft

' critères
For I = Range("A65536").End(xlUp).Row To 2 Step -1
If Not InStr(1, Range("D" & I), "EBBP", vbTextCompare) = 0 And IsEmpty(Range("E" & I)) = True Then _
Range("F" & I) = "POSITION EUROCLEAR"
If Not InStr(1, Range("D" & I), "EBTY", vbTextCompare) = 0 And IsEmpty(Range("E" & I)) = True Then _
Range("F" & I) = "POSITION TRIPARTY"
If Range("A" & I) = "Trade" And Range("A" & I + 1) = "Position" Then _
Rows(I + 1).Insert Shift:=xlDown
If Range("F" & I) = "POSITION TRIPARTY" And IsEmpty(Range("F" & I + 1)) = False Then _
Rows(I + 1).Insert Shift:=xlDown
Next I

For I = 2 To Range("A65536").End(xlUp).Row

If Range("F" & I) = "POSITION EUROCLEAR" Or _
Range("F" & I) = "POSITION TRIPARTY" Then ActiveCell.FormulaR1C1 = "=RC[7]"
Range("G7").Select

Next I

'Masquer N et O
Range("A1").Select
ActiveWindow.SmallScroll ToRight:=12
columns("N:O").Select
Selection.EntireColumn.Hidden = True

'mise en gras des colonnes
Range("B:B,D:E,G:H,I:J,L:L").Font.Bold = True

'séparateur de milliers
columns("G").NumberFormat = "#,##0"
columns("H").NumberFormat = "#,##0.00 _€"

'centrer les celule, fond blanc
With Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 2
End With
'premiere ligne plus large, en gras, et couleur de celule bleu turquoise
With Rows(1)
.Font.Bold = True
.RowHeight = 40
.Interior.ColorIndex = 34
End With
'zoom à 80%, ajustement automatique ligne colonne
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
Range("F15").Select

'mise en page, paysage, ajustée 1 page en largeur et 100 pages en longeurs, 0 marge droite gauche,
'centré vertical et horizontal, en-tete et pieds de page renseignés
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.CenterHeader = "&""Arial,Gras""&11 FAILS MONITOR GERMAN MARKET"
.RightHeader = "&D"
.LeftFooter = "&T"
.RightFooter = "&""Arial,Gras""&11Mr BOBY"
End With
Range("F15").Select

'zone d'impression jusqu'à la dernière ligne non vide
DerLig = Range("a65536").End(xlUp).Row
DerCol = Range("h40").End(xlToRight).Column
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(DerLig, DerCol)).Address

'fenetres / reorganiser / Horizontal
Windows.Arrange ArrangeStyle:=xlHorizontal
Application.ScreenUpdating = True

End Sub

 

[Gorfael]

Re : petites difficultés

Salut Boby et le forum

Il faut toujours garder en tête que tout super-extra-mega-génial que soit Excel, c'est un "autiste" (comme Rain Man ):
il fait ce qu'on lui dit de faire, sans le comprendre. Donc tu lui demande d'enregistrer, il le fait. Même le fait d'utiliser le scrolling pour atteindre la bonne cellule, il le marque.
Il faut donc toujours essayer de nettoyer le code. Au départ, une fois sur 2, on nettoie trop et ça marche plus, et avec l'habitude, on repère l'important et l'accessoire
nota Pour moi, autiste n'est pas une insulte, c'est un état qui me semble convenir à la situation : capable de dire combien il y a d'allumettes dans une boîte d'un simple regard, et perdu parce qu'on mange à 19h15 au lieu de 19h00

sur ta macro :

'Masquer N et O
Range("A1").Select
ActiveWindow.SmallScroll ToRight:=12
columns("N:O").Select
Selection.EntireColumn.Hidden = True

ça, c'est un pur code de l'engegistreur on peut élaguer :

'Masquer N et O
Columns("N:O").Hidden = True

un peu plus simple non ?

For I = 2 To Range("A65536").End(xlUp).Row

If Range("F" & I) = "POSITION EUROCLEAR" Or _
Range("F" & I) = "POSITION TRIPARTY" Then ActiveCell.FormulaR1C1 = "=RC[7]"
Range("G7").Select

Next I

ton code me laisse perplexe : je ne vois pas du tout ce que tu compte faire voilà comment je comprends ton code :

For I = 2 To Range("A65536").End(xlUp).Row

If Range("F" & I) = "POSITION EUROCLEAR" Or _
Range("F" & I) = "POSITION TRIPARTY" Then range("G7").FormulaR1C1 = "= N7"

Next I

Je pense que ce n'est pas ça le but, mais c'est ce que dit le code (pour moi en tout cas). Donc explique ce que tu veux faire avec ce code

A+

 

[boby]

Re : petites difficultés

bonjour a tous

mes problemes persistent

POSITION EUROCLEAR 79,200,000
POSITION TRIPARTY 85,823,000
BORROWED POSITION 24,200,000
TOTAL 189,223,000

comment puis je faire pour inserer ces lignes avec ces formules

merci

 

[boby]

Re : petites difficultés

BONJOUR Gorfael

en gros si tu te reporte au dernier fichier que j'ai envoyé,
je veux partie de l'onglet départ
et arrivee à l'onglet arrivéé

les formules que tu me donnes ne s'appliquent pas
je ne sais pas pour quelle raison

pour le moment je butte sur la partie qui concerne des formules toutes simples a appliquer

POSITION EUROCLEAR 79,200,000
POSITION TRIPARTY 85,823,000
BORROWED POSITION 24,200,000
TOTAL 189,223,000


je ne suis qu'un bricoleur
je ne suis pas un programmeur
et pas plus un otiste

 

[Gorfael]

Re : petites difficultés

Re boby
je ne suis qu'un bricoleur
je ne suis pas un programmeur
et pas plus un otiste : c'est pas de toi que je parlais, mais d'Excel (à moins que d'un coup d'oiel tu puisses me dire le nombre d'allumettes d'un boîte familiale )

Je crois que je commence à comprendre :
Donc, on a inseré 2 lignes avec le code précédent
Remplace

For I = 2 To Range("A65536").End(xlUp).Row

If Range("F" & I) = "POSITION EUROCLEAR" Or _
Range("F" & I) = "POSITION TRIPARTY" Then ActiveCell.FormulaR1C1 = "=RC[7]"
Range("G7").Select

Next I

Par

For I = 2 To Range("A65536").End(xlUp).Row
     if Range("F" & I)= "POSITION TRIPARTY" then
          Range("F" & I).Offsett(1,0) = "BORROWED POSITION"
          Range("F" & I).Offsett(2,0) = "TOTAL"

          Range("F" & I).Offsett(0,1) .FormulaR1C1 = "=RC[7]"
          if Range("F" & I)Offsett(-1,0)  = "POSITION EUROCLEAR" then
               Range("F" & I).Offsett(-1,1) .FormulaR1C1 = "=RC7]"
               Range("F" & I).Offsett(2,1) .FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
          Else
               Range("F" & I).Offsett(2,1) .FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
          End if
     end if
Next I

Pour I = 2 jusqu'à la dernière ligne non vide de A
Si Fi="POSITION TRIPARTY" alors
_____F(i+1) = "BORROWED POSITION"
_____F(i+2) = "TOTAL"

_____formule en Gi = "=Ni"
_____Si F(i-1) = "POSITION EUROCLEAR" alors
_____ _____formule G(i-1) = "= N(i-1)"
_____ _____formule G(i+2) = "=somme(G(i-1):G(i+1))
_____ Sinon
_____ _____formule G(i+2) = "=somme(G(i):G(i+1))
_____ Fin Si
Fin Si
Fin boucle

Range("A1").offset(1,2) => = cellule à +1 ligne, +2 colonne de A1 = C2
Range("F" & I).Offsett(2,1) <=> Range("G" & I + 2) <=> Cells(I+2,7)

FormulaR1C1 = "=SUM(R[-3]C:R[-1]C) formule au format R1C1 (Row Column)
R[-3]C <=> ligne()-3 Colonne()

Avec tout ça, ça devrait être un peu mieux comme résultat
A+

 

[boby]

Re : petites difficultés

il doit y avoir un probleme dans le code
car cette partie s'affiche en rouge
Range("F" & I).Offsett(0,1) .FormulaR1C1 = "=RC[7]"
if Range("F" & I)Offsett(-1,0) = "POSITION EUROCLEAR" then
Range("F" & I).Offsett(-1,1) .FormulaR1C1 = "=RC7]"
Range("F" & I).Offsett(2,1) .FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Else
Range("F" & I).Offsett(2,1) .FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
End If
End If
Next I


de mon coté j'ai reussi l'espace d'un instant a bricoler un truc
mais j'ai perdu le fil
je vais essayer de le retouver

 

[Gorfael]

Re : petites difficultés

il doit y avoir un probleme dans le code
car cette partie s'affiche en rouge
Range("F" & I).Offsett(0,1) .FormulaR1C1 = "=RC[7]"
if Range("F" & I)Offsett(-1,0) = "POSITION EUROCLEAR" then
Range("F" & I).Offsett(-1,1) .FormulaR1C1 = "=RC7]"
Range("F" & I).Offsett(2,1) .FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Else
Range("F" & I).Offsett(2,1) .FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
End If
End If
Next I


de mon coté j'ai reussi l'espace d'un instant a bricoler un truc
mais j'ai perdu le fil
je vais essayer de le retouver

re...
Oups

For I = 2 To Range("A65536").End(xlUp).Row
     If Range("F" & I) = "POSITION TRIPARTY" Then
          Range("F" & I).Offset(1, 0) = "BORROWED POSITION"
          Range("F" & I).Offset(2, 0) = "TOTAL"

          Range("F" & I).Offset(0, 1).FormulaR1C1 = "=RC[7]"
          If Range("F" & I).Offset(-1, 0) = "POSITION EUROCLEAR" Then
               Range("F" & I).Offset(-1, 1).FormulaR1C1 = "=RC[7]"
               Range("F" & I).Offset(1, 1).FormulaR1C1 = "=R[-2]C[8]"
               Range("F" & I).Offset(2, 1).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
          Else
               Range("F" & I).Offset(2, 1).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
          End If
     End If
Next I

Faire 3 trucs même temps n'a pas que des avantages
Je l'ai construit à la main, main je ne l'avais pas testé. Désolé !
Maintenant, elle tourne

A+

 

[boby]

Re : petites difficultés

bonjour Gorfael
bonjour le forum

je vais te soumettre la macro que j'ai enfin réussi a obtenir
j'ai tellmenet mal a la tete si tu savais!

mais il me reste un dernier petit probleme

DE EENDRAGT PENSIOEN N.V. AMS 1,720,000
No counterparty 30,000,000
No counterparty -30,000,000

EUROCLEAR POSITION 0
TRIPARTY POSITION 0
BORROWED POSITION 1,592,239
TOTAL 1,592,239

je souhaiterai que la cellule total face la somme de tout ces chiffres mais le probleme est qu'il y a une celule vide
je dois repeter cette action sur toute ma feuille

voici ma macro

Sub FAILS_MONITOR_GERMAN_MARKET()

Dim I As Integer
Dim code As String, debut1 As String, debut2 As String
Dim DerLig As Integer
Dim DerCol As Integer

Application.ScreenUpdating = False
Range("B:B,E:E,I:I,K:K,L:L,N:N,R:R,T:T,W:W").delete Shift:=xlToLeft
With Cells
.Interior.ColorIndex = 2
End With

' critères
For I = 2 To Range("A65536").End(xlUp).Row + 2
If Cells(I, 4) = "EBBP" And IsEmpty(Cells(I, 5)) = True Then
With Cells(I, 6)
.Value = " EUROCLEAR POSITION"
.Font.Bold = True
.Font.Color = vbBlue
.Interior.ColorIndex = 6
With Cells(I, 7)
.Value = Cells(I, 13).Value
.Font.Bold = True
.Interior.ColorIndex = 6
If .Value > 0 Then .Font.Color = vbBlue
If .Value < 0 Then .Font.Color = vbRed
End With

End With
End If
Next I

For I = 2 To Range("A65536").End(xlUp).Row + 2
If Cells(I, 4) = "EBTY" And IsEmpty(Cells(I, 5)) = True Then
With Cells(I, 6)
.Value = " TRIPARTY POSITION "
.Font.Bold = True
.Font.Color = vbPlum
.Interior.ColorIndex = 6
With Cells(I, 7)
.Value = Cells(I, 13).Value
.Font.Bold = True
.Interior.ColorIndex = 6
If .Value > 0 Then .Font.Color = vbBlue
If .Value < 0 Then .Font.Color = vbRed
End With

End With
End If
Next I

'boucle sur les lignes
For I = Range("A65536").End(xlUp).Row To 3 Step -1
If Cells(I, 1).Value <> Cells(I + 1, 1).Value = True Then _
Rows(I + 1).Insert Shift:=xlDown
If Cells(I, 1).Value = "Position" And IsEmpty(Cells(I + 1, 1).Value) = True Then _
Rows(I + 1 & ":" & I + 2).Insert Shift:=xlDown
Next I

'boucle sur les lignes pour mise en forme
For I = 2 To Range("A65536").End(xlUp).Row + 2
If IsEmpty(Cells(I, 6)) = True And IsEmpty(Cells(I + 1, 6)) = True Then
With Cells(I, 6)
.Value = "BORROWED POSITION"
.Font.Bold = True
.Font.Color = vbRed
.Interior.ColorIndex = 6
With Cells(I, 7)
.Value = Cells(I - 2, 14).Value
.Font.Bold = True
.Interior.ColorIndex = 6
If .Value > 0 Then .Font.Color = vbBlue
If .Value < 0 Then .Font.Color = vbRed
End With

End With
With Cells(I + 1, 6)
.Value = "TOTAL"
.Font.Bold = True
.Font.Color = vbBlack
.Interior.ColorIndex = 6
With Cells(I + 1, 7)
.Value = Cells(I, 7).Value + Cells(I - 1, 7).Value + Cells(I - 2, 7).Value
.Font.Bold = True
.Interior.ColorIndex = 6
If .Value > 0 Then .Font.Color = vbBlue
If .Value < 0 Then .Font.Color = vbRed
End With
End With

End If
Next I

For I = 2 To Range("A65536").End(xlUp).Row - 2
If IsEmpty(Cells(I, 6)) = False And IsEmpty(Cells(I + 1, 6)) = True Then
With Cells(I + 1, 6)
.Interior.ColorIndex = 2
With Cells(I + 1, 7)
.Interior.ColorIndex = 2
End With
End With
End If
Next I

'Supprimer N et O
Range("N:O").delete Shift:=xlToLeft

'mise en gras des colonnes
Range("B:B,D:E,I:J,K:K,N:N").Font.Bold = True

'séparateur de milliers
columns("G").NumberFormat = "#,##0"
columns("H").NumberFormat = "#,##0.00 _€"

'centrer les celule, fond blanc
With Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'premiere ligne plus large, en gras, et couleur de celule bleu turquoise
With Rows(1)
.Font.Bold = True
.RowHeight = 40
.Interior.ColorIndex = 34
End With
'zoom à 80%, ajustement automatique ligne colonne
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
Range("F15").Select

'mise en page, paysage, ajustée 1 page en largeur et 100 pages en longeurs, 0 marge droite gauche,
'centré vertical et horizontal, en-tete et pieds de page renseignés
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.CenterHeader = "&""Arial,Gras""&11 FAILS MONITOR GERMAN MARKET"
.RightHeader = "&D"
.LeftFooter = "&T"
.RightFooter = "&""Arial,Gras""&11Mr BOBY"
End With
Range("F15").Select

'zone d'impression jusqu'à la dernière ligne non vide
DerLig = Range("a65536").End(xlUp).Row
DerCol = Range("h40").End(xlToRight).Column
ActiveSheet.PageSetup.PrintArea = Range("A1:" & Cells(DerLig, DerCol).Address).Address

'fenetres / reorganiser / Horizontal
Windows.Arrange ArrangeStyle:=xlHorizontal
Application.ScreenUpdating = True

End Sub

Je n'ai pas encore eu le temps d'essayer le dernier code que tu m'as donné mais je te promet de le faire

merci