VBA :inserer ligne et étiquettes sous conditions

[bertrand1202]

Bonjour


J'arrive à insérer des lignes et des étiquettes sous conditions
Par contre , cela ne réagit pas au niveau de chaque feuille , j'ai essayé avec Workbookworksheets.activate, ça ne réagit pas .

Le code pour insérer les lignes peut il ^etre simplifié en mettant les varaiables ainsi {707900;total1;606800;total2;etc}de manière à avoir une correspondance et éviter les elseif.

Merci de votre aide .

J'ai également essayé avec while do loop mais cette méthode n'accepyte qu'une condition apparemment ;Je suis revenu sur for each même si ce n'est pas le plus propre.

Merci
Bonne journée.

 

[biloute91]

Re : VBA :inserer ligne et étiquettes sous conditions

Bonjour,

je ne sais pas si cela correspond mais j'ai fait une modification dans ton code

Sub inserelignesousconditions()
'
' inserelignesousconditions Macro
' Macro enregistrée le 05/10/2009 par Customer
'

'

Dim Vintitulé As Range

Dim Plage As Range
Dim i As Integer
[COLOR="red"]With Worksheets[/COLOR]
For i = 1 To 500 'comment alléger ppour faire référence à dernière ligne de la plage
  'activer toutes les feuilles pour que cela s'opère dans toutes les feuilles
Set Plage = Range("a1:a65536").End(xlUp)
For Each Vintitulé In Plage

 If Vintitulé(i, 1).Value = "707900" Then
   Cells(Vintitulé(i).Row + 1, 1).EntireRow.Insert Shift:=xlDown
  Cells(Vintitulé(i).Row + 1, 1) = "Total1"
 ElseIf Vintitulé(i, 1).Value = "606500" Then
   Cells(Vintitulé(i).Row + 1, 1).EntireRow.Insert Shift:=xlDown
  Cells(Vintitulé(i).Row + 1, 1) = "Total2"
  ElseIf Vintitulé(i, 1).Value = "607000" Then
   Cells(Vintitulé(i).Row + 1, 1).EntireRow.Insert Shift:=xlDown
  Cells(Vintitulé(i).Row + 1, 1) = "Total3"
  
End If

Next Vintitulé
 Next i
 [COLOR="Red"]End With[/COLOR]
End Sub

 

[Gael]

Re : VBA :inserer ligne et étiquettes sous conditions

Bonjour bertrand, Biloute,

Essaye le code suivant:

Sub inserelignesousconditions()
Dim Vintitulé As Range
Dim i As Byte
Dim compte As Variant
Dim Num As Variant
Dim F As Worksheet
Dim Plage As Range
Num = Array(707900, 606500, 607000)
For Each F In Sheets
F.Activate
Set Plage = Range("a7:a" & Range("a65536").End(xlUp).Row)
    For Each Vintitulé In Plage
        i = 0
        For Each compte In Num
            i = i + 1
            If Vintitulé = compte Then
            Cells(Vintitulé.Row + 1, 1).Insert Shift:=xlDown
            Cells(Vintitulé.Row + 1, 1) = "Total" & i
            End If
        Next compte
    Next Vintitulé
Next F
End Sub

@+

Gael

 

[bertrand1202]

Re : VBA :inserer ligne et étiquettes sous conditions

Bojour Biloute 91


J'ai modifié mon code mais cela ne réagit pas .je vais essayer en faisant for each ws in workbookworksheet et en modifiant l'autre for each car Vba ne semble pas accepter deux fois For each

Merci de ton aide.

Je continue les recherches.
@+

 

[bertrand1202]

Re : VBA :inserer ligne et étiquettes sous conditions

Re



Merci à Gael et Biloute 91, en remodifiant le code, ça marche impeccable.

Merci encore

Bertrand