diviser une macro en 2

neim · 9 Juillet 2019

Bonjour à tous,

J'ai la macro ci dessous qui fait 2 opérations :

1.) decoupe certaines lignes et les copies dans une autre deuille

2.) recopie les formules sur les 500 premieres lignes.

Je souhaiterai separer ces tâches et faire en fait 2 macro différentes, mais lorsque j'essai il y a des problemes de syntaxe.

Je souhaiterai egalement pour la deuxieme partie copier les formules sur les 500 premieres lignes vides, et non plus les 500 premieres lignes.

Si quelqu'un aurait une idee

Voici la macro en question :

Option Explicit
Sub Archivage()

Dim i As Long, DerLig As Long, PremLig As Long

Application.ScreenUpdating = False
With Sheets("Besoins")
DerLig = Application.Max(.Range("A" & Rows.Count).End(xlUp).Row, 2)
For i = DerLig To 2 Step -1
If .Range("R" & i) <> "" Then
PremLig = Sheets("Archives").Range("B" & Rows.Count).End(xlUp).Row + 1
Sheets("Archives").Range("B" & PremLig & ":R" & PremLig).Value = .Range("B" & i & ":R" & i).Value
.Range("A" & i & ":R" & i).Delete
End If
Next i
For i = 2 To 2500
Cells(i, 1).FormulaR1C1 = "=IF(RC[1]="""","""",IF(RC[1]=R[-1]C[1],R[-1]C,R[-1]C+1))"
If IsEmpty(.Cells(i, 11)) Then .Cells(i, 11).FormulaR1C1 = "=IF(RC1="""","""",IFERROR(VLOOKUP(RC2,'Stock proto'!C2:C3,2,False),0))"
If IsEmpty(.Cells(i, 12)) Then .Cells(i, 12).FormulaR1C1 = "=IF(RC[-11]="""","""",IF(RC[-3]-RC[-1]<0,0,RC[-3]-RC[-1]))"
If IsEmpty(.Cells(i, 13)) Then .Cells(i, 13).FormulaR1C1 = "=IF(RC[-12]="""","""",IF(RC[-1]=0,"""",""job à créer""))"
If IsEmpty(.Cells(i, 15)) Then .Cells(i, 15).FormulaR1C1 = "=IF(RC[-14]="""","""",IF(COUNTIF(C[-8]:C[-8],RC[-8])>1,(SUMIF(C[-8]:C[-6],RC[-8],C[-6]:C[-6])-SUMIF(C[-8]:C[-1],RC[-8],C[-1]:C[-1])),""""))"
If IsEmpty(.Cells(i, 17)) Then .Cells(i, 17).FormulaR1C1 = "=IF(AND(RC[-11]<TODAY(),RC[-1]<TODAY(),RC[-1]<>""""),""Retard composant et livraison"",IF(AND(RC[-11]<TODAY(),RC[-11]<>""""),""Retard livraison"",IF(AND(RC[-1]<>"""",RC[-1]<TODAY()),""Retard composant"","""")))"
Next i
End With
Application.ScreenUpdating = True

End Sub

Robert · 9 Juillet 2019

Bon jour Neim, bonjour le forum,

Peut-être comme ça :

VB:

Option Explicit

Sub Macro1()
Dim I As Long, DerLig As Long, PremLig As Long
Application.ScreenUpdating = False
With Sheets("Besoins")
    DerLig = Application.Max(.Range("A" & Rows.Count).End(xlUp).Row, 2)
    For I = DerLig To 2 Step -1
        If .Range("R" & I) <> "" Then
            PremLig = Sheets("Archives").Range("B" & Rows.Count).End(xlUp).Row + 1
            Sheets("Archives").Range("B" & PremLig & ":R" & PremLig).Value = .Range("B" & I & ":R" & I).Value
            .Range("A" & I & ":R" & I).Delete
        End If
    Next I
End With
End Sub

VB:

Sub Macro2()
Dim DL As Long
Dim I As Long

Application.ScreenUpdating = False
With Sheets("Besoins")
    DL = Cells(Application.Rows.Count, "A").End(xlUp).Row
    For I = DL To DL + 500
        .Cells(I, 1).FormulaR1C1 = "=IF(RC[1]="""","""",IF(RC[1]=R[-1]C[1],R[-1]C,R[-1]C+1))"
        If IsEmpty(.Cells(I, 11)) Then .Cells(I, 11).FormulaR1C1 = "=IF(RC1="""","""",IFERROR(VLOOKUP(RC2,'Stock proto'!C2:C3,2,False),0))"
        If IsEmpty(.Cells(I, 12)) Then .Cells(I, 12).FormulaR1C1 = "=IF(RC[-11]="""","""",IF(RC[-3]-RC[-1]<0,0,RC[-3]-RC[-1]))"
        If IsEmpty(.Cells(I, 13)) Then .Cells(I, 13).FormulaR1C1 = "=IF(RC[-12]="""","""",IF(RC[-1]=0,"""",""job à créer""))"
        If IsEmpty(.Cells(I, 15)) Then .Cells(I, 15).FormulaR1C1 = "=IF(RC[-14]="""","""",IF(COUNTIF(C[-8]:C[-8],RC[-8])>1,(SUMIF(C[-8]:C[-6],RC[-8],C[-6]:C[-6])-SUMIF(C[-8]:C[-1],RC[-8],C[-1]:C[-1])),""""))"
        If IsEmpty(.Cells(I, 17)) Then .Cells(I, 17).FormulaR1C1 = "=IF(AND(RC[-11]<TODAY(),RC[-1]<TODAY(),RC[-1]<>""""),""Retard composant et livraison"",IF(AND(RC[-11]<TODAY(),RC[-11]<>""""),""Retard livraison"",IF(AND(RC[-1]<>"""",RC[-1]<TODAY()),""Retard composant"","""")))"
    Next I
End With
Application.ScreenUpdating = True
End Sub

neim · 17 Juillet 2019

Bonjour,

Désolé, je n'ai pas pu répondre plus vite.

Merci, ca fonctionne bien.

Par contre, pour la formule couper/copier, est il possible d'ajouter un tri du fichier à la fin ?

J'aimerai faire un tri sur les colonnes :

- colonne F
- colonne B
- colonne K
- colonne G

Je remet la formule à jour si dessous

Merci

Option Explicit

Sub Archivage()
Dim I As Long, DerLig As Long, PremLig As Long
Application.ScreenUpdating = False
With Sheets("Besoins")
DerLig = Application.Max(.Range("A" & Rows.Count).End(xlUp).Row, 2)
For I = DerLig To 2 Step -1
If .Range("W" & I) <> "" Then
PremLig = Sheets("Archives mois en cours").Range("B" & Rows.Count).End(xlUp).Row + 1
Sheets("Archives mois en cours").Range("B" & PremLig & ":W" & PremLig).Value = .Range("B" & I & ":W" & I).Value
.Range("B" & I & ":W" & I).Delete
End If
Next I
End With
End Sub

diviser une macro en 2

neim

XLDnaute Junior

Robert

XLDnaute Barbatruc

neim

XLDnaute Junior

Discussions similaires