MACRO ajout d'une ligne avec condition et ajout de données

Version imprimable

13/07/2015, 10h24
Helea

1 pièce(s) jointe(s)

MACRO ajout d'une ligne avec condition et ajout de données

Bonjour,
Je suis nulle concernant la fonction Macro et j'aimerai une aide s'il vous plait.
J'ai un tableau avec 11 colonnes (de A à K) et j'aimerai ajouter une ligne au dessus si dans la colonne "C" il y a une donnée débutant par "AC" en ajoutant dans cette nouvelle ligne les données des colonnes "I" et "J" si elles débutent par "AL" ; dans les colonnes "C" et "E" si dans la colonne "C" il y a une donnée débutant par "AC"
Avec ajout d'un bouton à droite sur le fichier.
Par avance merci de votre aide.

Bonjour Helea,

Ce que tu demandes est relativement simple.
Cependant l'explication laisse à désirer...

Ce que j'ai compris :

Ajouter une ligne si en C on trouve une donnée commençant par "AC",
Recopier les valeurs de I et J si I commence par "AL",
Recopier les valeurs de C et E si C commence par "AC" (mais ça sera toujours le cas ?!?!).

Si tel est le cas, voici :

Code:

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
Option Explicit
 
Sub ajout_ligne()
Dim oRng As Range
Dim i As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
With Worksheets("Test 1")
    Set oRng = .Range("C1")
    For i = .Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
        If Left(oRng.Offset(i, 0), 2) = "AC" Then
            .Rows(i + 2 & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            oRng.Offset(i + 1, 0) = oRng.Offset(i, 0)
            oRng.Offset(i + 1, 2) = oRng.Offset(i, 2)
            If Left(oRng.Offset(i, 6), 2) = "AL" Then
                oRng.Offset(i + 1, 6) = oRng.Offset(i, 6)
                oRng.Offset(i + 1, 7) = oRng.Offset(i, 7)
            End If
        End If
    Next i
End With
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

N'hésite pas à revenir vers moi ! :ccool:

Cordialement,
Kimy

13/07/2015, 12h26
Helea

Bonjour Kimy et merci pour ton aide.
Ce n'est pas tout à fait cela, je me suis mal expliquée :

Ajouter une ligne (au dessus de la ligne ou se trouve "AC" en C) si en C on trouve une donnée commençant par "AC",
Recopier les valeurs de I et J si I commence par "AL", (dans la ligne vierge insérée) et dans les colonnes C et F
La valeur I devant être copiée dans C et la valeur J copiée dans F (dans la ligne vierge insérée précédemment)

J'espère que la compréhension est meilleure maintenant.
A te lire Kimy et merci beaucoup
Héléa

je viens de voir qu'il y a une condition supplémentaire à ma demande, donc je reformule :

Ajouter une ligne (au dessus de la ligne ou se trouve "AC" en C) si en C on trouve une donnée commençant par "AC",
Recopier les valeurs de I et J si I commence par "AL" et que dans K la valeur "6" est indiquée, (dans la ligne vierge insérée) et dans les colonnes C et F
La valeur I devant être copiée dans C et la valeur J copiée dans F (dans la ligne vierge insérée précédemment)

Désolée si c'est confus !
Merci encore Kimy

Helea,

Si je comprends bien, si C commence par "AC" mais que I ne commence pas par "AL" ou que K ne contient pas la valeur "6", une ligne sera ajoutée sans valeur ?
Dans ce cas :

Code:

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
Option Explicit
 
Sub ajout_ligne()
Dim oRng As Range
Dim i As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
With Worksheets("Test 1")
    Set oRng = .Range("C1")
    For i = .Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
        'Si C commence par "AC"
        If Left(oRng.Offset(i, 0), 2) = "AC" Then
            'Insertion d'une ligne
            .Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
            'Si I de l'ancienne ligne commence par "AL" et K = 6
            If Left(oRng.Offset(i + 1, 6), 2) = "AL" And oRng.Offset(i + 1, 8) = 6 Then
                'Sur la nouvelle ligne (en C) recopier ce qu'on a en I
                oRng.Offset(i, 0) = oRng.Offset(i + 1, 6)
                'Sur la nouvelle ligne (en F) recopier ce qu'on a en J
                oRng.Offset(i, 3) = oRng.Offset(i + 1, 7)
            End If
        End If
    Next i
End With
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

Cordialement,
Kimy

13/07/2015, 14h04
Helea

Merci

Merci Kimy c'est parfait.
Bonne journée à toi.
Héléa