Discussion :

[pticode]

Bonjour à tous,

J'aimerai créer une macro permettant de dupliquer mes lignes et remplacer les montants de mes colonnes H et I (qui varient selon le sens, formule S) selon les infos des colonnes L et K.
1ère ligne montant d'origine inchangé
2ème ligne montant en colonne K et "706" en colonne E / En H =SI(Kx>0;Kx;"") en I =SI(Kx<0;-Kx;"")
3eme ligne montant en colonne L et "44571" en colonne E / En L =SI(Lx>0;Lx;"") en I =SI(Lx<0;-Lx;"")

Enfin, effectuer un tri par références de A à Z

Cf image ci dessous



Merci d'avance !

[Fab_de_chez_PERFORM]

Bonjour

je propose ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Macro1()
 
Dim F1 As String
Dim F2 As String
F1 = "Test" 'nom feuille 1
F2 = "Rendu" 'nom feuille 2
 
Dim Ligne_Départ_F1 As String
Dim Ligne_Fin_F1 As String
 
Ligne_Départ_F1 = 2 'mettre le numéro de la 1e ligne à traiter
Ligne_Fin_F1 = Sheets(F1).Range("A" & Rows.Count).End(xlUp).Row
 
If MsgBox("Doit on virer les données sur la feuille 2 avant de commencer ?", vbYesNo, "Question") = vbYes Then
    Dim Ligne_Fin_F2 As String
    Ligne_Fin_F2 = Sheets(F2).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(F2).Rows("2:" & Ligne_Fin_F2).ClearContents
End If
 
'Loop
 
Dim i As Integer 'integer à changer si plus de 30 000 lignes
 
For i = Ligne_Départ_F1 To Ligne_Fin_F1
 
    Sheets(F1).Select
    Rows(i & ":" & i).Copy
 
    'Copier/coller en 3 lignes
    Sheets(F2).Select
    If i = 2 Then
    Rows("2:4").Select
    Else
    Range("A" & Sheets(F2).Range("A" & Rows.Count).End(xlUp).Row + 1 & ":A" & Sheets(F2).Range("A" & Rows.Count).End(xlUp).Row + 3).Select
    End If
    ActiveSheet.Paste
 
    'modif des lignes
    Range("E" & i * 3 - 3).Value = "706"
    Range("H" & i * 3 - 3).FormulaR1C1 = "=IF(RC[3]>0,RC[3],"""")"
    Range("I" & i * 3 - 3).FormulaR1C1 = "=IF(RC[2]<0,-RC[2],"""")"
 
    Range("I" & i * 3 - 2).ClearContents
    Range("E" & i * 3 - 2).Value = "44571"
    Range("H" & i * 3 - 2).FormulaR1C1 = "=IF(RC[4]>0,RC[4],"""")"
    Range("I" & i * 3 - 2).FormulaR1C1 = "=IF(RC[3]<0,-RC[3],"""")"
 
Next i
 
MsgBox ("ok terminé")
 
End Sub

Je mets le fichier en PJ

J'ai fait vite donc sans doute améliorable

[pticode]

Ca fonctionne parfaitement, merci beaucoup !