Ajout de lignes absentes

Bonjour, je vais essayer d'être le plus concis possible.

1- J'extrais de mon soft l'excel suivant :

Date Etape Nombre Type

19/10/2015 MISE EN CASSETTE 883 Blocs

20/10/2015 MISE EN CASSETTE 925 Blocs

21/10/2015 MISE EN CASSETTE 693 Blocs

22/10/2015 MISE EN CASSETTE 855 Blocs

23/10/2015 MISE EN CASSETTE 829 Blocs

19/10/2015 MISE EN HYPERCENTRE 855 Blocs

20/10/2015 MISE EN HYPERCENTRE 836 Blocs

21/10/2015 MISE EN HYPERCENTRE 673 Blocs

22/10/2015 MISE EN HYPERCENTRE 822 Blocs

23/10/2015 MISE EN HYPERCENTRE 797 Blocs

19/10/2015 INCLUSION 754 Blocs

20/10/2015 INCLUSION 841 Blocs

21/10/2015 INCLUSION 830 Blocs

22/10/2015 INCLUSION 601 Blocs

23/10/2015 INCLUSION 759 Blocs

19/10/2015 COUPE 804 Blocs

20/10/2015 COUPE 768 Blocs

21/10/2015 COUPE 718 Blocs

22/10/2015 COUPE 861 Blocs

23/10/2015 COUPE 890 Blocs

19/10/2015 RENDU PLATEAU MORPHO 989 Lames

20/10/2015 RENDU PLATEAU MORPHO 881 Lames

21/10/2015 RENDU PLATEAU MORPHO 1003 Lames

22/10/2015 RENDU PLATEAU MORPHO 1011 Lames

23/10/2015 RENDU PLATEAU MORPHO 1037 Lames

19/10/2015 RENDU PLATEAU IHC 332 Lames

20/10/2015 RENDU PLATEAU IHC 234 Lames

21/10/2015 RENDU PLATEAU IHC 440 Lames

22/10/2015 RENDU PLATEAU IHC 386 Lames

23/10/2015 RENDU PLATEAU IHC 430 Lames

19/10/2015 RENDU PLATEAU IF/PF/HE 67 Lames

21/10/2015 RENDU PLATEAU IF/PF/HE 228 Lames

22/10/2015 RENDU PLATEAU IF/PF/HE 103 Lames

19/10/2015 RENDU PLATEAU CYTO 61 Lames

20/10/2015 RENDU PLATEAU CYTO 202 Lames

21/10/2015 RENDU PLATEAU CYTO 121 Lames

22/10/2015 RENDU PLATEAU CYTO 179 Lames

23/10/2015 RENDU PLATEAU CYTO 170 Lames

20/10/2015 RENDU PLATEAU FISH 12 Lames

22/10/2015 RENDU PLATEAU FISH 9 Lames

23/10/2015 RENDU PLATEAU FISH 58 Lames

Mon problème : certaines étapes (2ème colonne) ne sont pas réalisées systématiquement et donc sont absentes certains jours or, j'ai besoin de les faire apparaitre avec une valeur "0"

Ce que je voudrais donc = ajouter les lignes en rouge. .

ATTENTION !! C'est une extraction hebdomadaire donc le lundi 19 devient le lundi 26 puis 2 novembre, etc...

Date Etape Nombre Type

19/10/2015 MISE EN CASSETTE 883 Blocs

20/10/2015 MISE EN CASSETTE 925 Blocs

21/10/2015 MISE EN CASSETTE 693 Blocs

22/10/2015 MISE EN CASSETTE 855 Blocs

23/10/2015 MISE EN CASSETTE 829 Blocs

19/10/2015 MISE EN HYPERCENTRE 855 Blocs

20/10/2015 MISE EN HYPERCENTRE 836 Blocs

21/10/2015 MISE EN HYPERCENTRE 673 Blocs

22/10/2015 MISE EN HYPERCENTRE 822 Blocs

23/10/2015 MISE EN HYPERCENTRE 797 Blocs

19/10/2015 INCLUSION 754 Blocs

20/10/2015 INCLUSION 841 Blocs

21/10/2015 INCLUSION 830 Blocs

22/10/2015 INCLUSION 601 Blocs

23/10/2015 INCLUSION 759 Blocs

19/10/2015 COUPE 804 Blocs

20/10/2015 COUPE 768 Blocs

21/10/2015 COUPE 718 Blocs

22/10/2015 COUPE 861 Blocs

23/10/2015 COUPE 890 Blocs

19/10/2015 RENDU PLATEAU MORPHO 989 Lames

20/10/2015 RENDU PLATEAU MORPHO 881 Lames

21/10/2015 RENDU PLATEAU MORPHO 1003 Lames

22/10/2015 RENDU PLATEAU MORPHO 1011 Lames

23/10/2015 RENDU PLATEAU MORPHO 1037 Lames

19/10/2015 RENDU PLATEAU IHC 332 Lames

20/10/2015 RENDU PLATEAU IHC 234 Lames

21/10/2015 RENDU PLATEAU IHC 440 Lames

22/10/2015 RENDU PLATEAU IHC 386 Lames

23/10/2015 RENDU PLATEAU IHC 430 Lames

19/10/2015 RENDU PLATEAU IF/PF/HE 67 Lames

20/10/2015 RENDU PLATEAU IF/PF/HE 0 Lames

21/10/2015 RENDU PLATEAU IF/PF/HE 228 Lames

22/10/2015 RENDU PLATEAU IF/PF/HE 103 Lames

23/10/2015 RENDU PLATEAU IF/PF/HE 0 Lames

19/10/2015 RENDU PLATEAU CYTO 61 Lames

20/10/2015 RENDU PLATEAU CYTO 202 Lames

21/10/2015 RENDU PLATEAU CYTO 121 Lames

22/10/2015 RENDU PLATEAU CYTO 179 Lames

23/10/2015 RENDU PLATEAU CYTO 170 Lames

19/10/2015 RENDU PLATEAU FISH 0 Lames

20/10/2015 RENDU PLATEAU FISH 12 Lames

21/10/2015 RENDU PLATEAU FISH 0 Lames

22/10/2015 RENDU PLATEAU FISH 9 Lames

23/10/2015 RENDU PLATEAU FISH 58 Lames

19/10/2015 RENDU PLATEAU ME 0 Lames

20/10/2015 RENDU PLATEAU ME 0 Lames

21/10/2015 RENDU PLATEAU ME 0 Lames

22/10/2015 RENDU PLATEAU ME 0 Lames

23/10/2015 RENDU PLATEAU ME 0 Lames

HELP!

Merci d'avance


https://www.cjoint.com/c/EJDmVEw3Ef7

Un lien cjoint sera beaucoup plus pratique pour tout le monde

utiliser le 1er onglet "import" comme départ

Une 1ère tentative de macro m'a été transmise par une âme charitable internaute.

Malheureusement elle ne fonctionne pas.

Macro en question :

Sub Controle()

Application.ScreenUpdating = False

Dim Param1Trouve As Boolean, Param2Trouve As Boolean, Param3Trouve As Boolean

Dim Param1 As String, Param2 As String, Param3 As String

Dim DerLig As Integer

Param1 = "RENDU PLATEAU IF/PF/HE"

Param2 = "RENDU PLATEAU Microscopie Electr"

Param3 = "RENDU PLATEAU FISH"

DerLig = [A100000].End(xlUp).Row

For j = DerLig To 2 Step -1

DateJour = Cells(j, 1)

If Cells(j, 2) = Param1 Then Param1Trouve = True

If Cells(j, 2) = Param2 Then Param2Trouve = True

If Cells(j, 2) = Param3 Then Param3Trouve = True

If Cells(j, 1) <> Cells(j - 1, 1) Then

For k = 1 To 4

Rows(j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Next k

If Param1Trouve = False Then

Cells(j + 1, 1) = DateJour

Cells(j + 1, 2) = Param1

Cells(j + 1, 3) = 0

If Param2Trouve = False Then

Cells(j + 2, 1) = DateJour

Cells(j + 2, 2) = Param2

Cells(j + 2, 3) = 0

If Param3Trouve = False Then

Cells(j + 3, 1) = DateJour

Cells(j + 3, 2) = Param3

Cells(j + 3, 3) = 0

End If

End If

End If

End If

Next j

DerLig = [A100000].End(xlUp).Row

For i = DerLig To 2 Step -1

If Cells(i, 1) = "" And Cells(i - 1, 1) = "" Then Cells(i, 1).EntireRow.Delete

If Cells(i, 1) = "" And Cells(i + 1, 1) = Cells(i - 1, 1) Then Cells(i, 1).EntireRow.Delete

Next i

If Cells(2, 1) = "" Then Cells(2, 1).EntireRow.Delete

End Sub

Bonjour

Ci joint une première proposition de traitement de l'import

copier l'import sur l'onglet Import puis faire CTRL+Maj T

a tester avant de lancer la suite

pourquoi des lignes intermédiaires dans le traité ?

Cordialement

FINDRH

11insert-lignes.xlsm (32.03 Ko)

J'ai réussi à trouver ma réponse grâce à un internaute qui m'a sauvé la soirée.

J'avoue ne pas avoir encore bien compris les tenants et aboutissants mais ça marche.

Solution :

Sheets("import détail morpho").Select

Sheets("import détail morpho").Copy Before:=Sheets(1)

Sheets("import détail morpho (2)").Select

Sheets("import détail morpho (2)").Move Before:=Sheets(5)

Sheets("import détail morpho (2)").Select

Sheets("import détail morpho (2)").Name = "import corrigé"

ActiveWindow.SmallScroll Down:=-9

Range("A2:E205").Select

Selection.ClearContents

ActiveWindow.SmallScroll Down:=-36

Range("A2").Select

ActiveCell.FormulaR1C1 = "='import détail morpho'!RC"

Range("A2").Select

Selection.AutoFill Destination:=Range("A2:A5"), Type:=xlFillDefault

Range("A2:A5").Select

Selection.AutoFill Destination:=Range("A2:A6"), Type:=xlFillDefault

Range("A2:A6").Select

Range("A7").Select

ActiveCell.FormulaR1C1 = "=R2C"

Range("A8").Select

ActiveCell.FormulaR1C1 = "=R3C"

Range("A9").Select

ActiveCell.FormulaR1C1 = "=R4C"

Range("A10").Select

ActiveCell.FormulaR1C1 = "=R5C"

Range("A11").Select

ActiveCell.FormulaR1C1 = "=R6C"

Range("A7:A11").Select

Selection.Copy

Range("A12").Select

ActiveSheet.Paste

Range("A17").Select

ActiveSheet.Paste

Range("A22").Select

ActiveSheet.Paste

Range("A27").Select

ActiveSheet.Paste

Range("A32").Select

ActiveSheet.Paste

Range("B2").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "='import détail morpho'!RC"

Range("B3").Select

ActiveCell.FormulaR1C1 = "=R2C"

Range("B3").Select

Selection.Copy

Range("B4").Select

ActiveSheet.Paste

Range("B5").Select

ActiveSheet.Paste

Range("B6").Select

ActiveSheet.Paste

Range("B7").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "='import détail morpho'!RC"

Range("B8").Select

ActiveCell.FormulaR1C1 = "=R[-1]C"

Range("B8").Select

ActiveCell.FormulaR1C1 = "=R7C"

Range("B8").Select

Selection.Copy

Range("B9").Select

ActiveSheet.Paste

Range("B10").Select

ActiveSheet.Paste

Range("B11").Select

ActiveSheet.Paste

Range("B12").Select

Application.CutCopyMode = False

Range("B7").Select

ActiveCell.FormulaR1C1 = "MISE EN HYPERCENTRE"

Range("B12").Select

Sheets("import corrigé").Select

ActiveCell.FormulaR1C1 = "INCLUSION"

Range("B13").Select

ActiveCell.FormulaR1C1 = "=R12C"

Range("B13").Select

Selection.Copy

Range("B14").Select

ActiveSheet.Paste

Range("B15").Select

ActiveSheet.Paste

Range("B16").Select

ActiveSheet.Paste

Range("B17").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "COUPE"

Range("B18").Select

ActiveCell.FormulaR1C1 = "=R17C2"

Range("B18").Select

Selection.Copy

Range("B19").Select

ActiveSheet.Paste

Range("B20").Select

ActiveSheet.Paste

Range("B21").Select

ActiveSheet.Paste

Range("B22").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "=RENDU PLATEAU MORPHO"

Range("B22").Select

ActiveCell.FormulaR1C1 = "RENDU PLATEAU MORPHO"

Range("B23").Select

ActiveCell.FormulaR1C1 = "=R22C"

Range("B23").Select

Selection.Copy

Range("B24").Select

ActiveSheet.Paste

Range("B25").Select

ActiveSheet.Paste

Range("B26").Select

ActiveSheet.Paste

Range("B27").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = ""

Sheets("import corrigé").Select

ActiveCell.FormulaR1C1 = "RENDU PLATEAU IHC"

Range("B28").Select

ActiveCell.FormulaR1C1 = "=R27C"

Range("B28").Select

Selection.Copy

Range("B29").Select

ActiveSheet.Paste

Range("B30").Select

ActiveSheet.Paste

Range("B31").Select

ActiveSheet.Paste

Range("B32").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "RENDU PLATEAU FISH"

Range("B33").Select

Sheets("import corrigé").Select

Range("B32").Select

ActiveCell.FormulaR1C1 = "RENDU PLATEAU IF/PF/HE"

Range("B33").Select

ActiveCell.FormulaR1C1 = "=R[-1]C"

Range("B33").Select

ActiveCell.FormulaR1C1 = "=R32C"

Range("B33").Select

Selection.Copy

Range("B34").Select

ActiveSheet.Paste

Range("B35").Select

ActiveSheet.Paste

Range("B36").Select

ActiveSheet.Paste

Range("A32:A36").Select

Application.CutCopyMode = False

Selection.Copy

Range("A37").Select

ActiveSheet.Paste

Range("B37").Select

Sheets("import corrigé").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "RENDU PLATEAU CYTO"

Range("B38").Select

ActiveCell.FormulaR1C1 = "=R37C"

Range("B38").Select

Selection.Copy

Range("B39").Select

ActiveSheet.Paste

Range("B40").Select

ActiveSheet.Paste

Range("B41").Select

ActiveSheet.Paste

Range("A37:A41").Select

Application.CutCopyMode = False

Selection.Copy

Range("A42").Select

ActiveSheet.Paste

Range("A47").Select

ActiveSheet.Paste

Range("B42").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "RENDU PLATEAU FISH"

Range("B43").Select

ActiveCell.FormulaR1C1 = "=R[-1]C"

Range("B43").Select

ActiveCell.FormulaR1C1 = "=R42C"

Range("B43").Select

Selection.Copy

Range("B44").Select

ActiveSheet.Paste

Range("B45").Select

ActiveSheet.Paste

Range("B46").Select

ActiveSheet.Paste

Range("B47").Select

Sheets("import détail morpho").Select

Range("B42").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "RENDU PLATEAU Microscopie Electr"

Sheets("import corrigé").Select

Range("B47").Select

ActiveCell.FormulaR1C1 = "RENDU PLATEAU Microscopie Electr"

Range("B48").Select

ActiveCell.FormulaR1C1 = "=R47C"

Range("B48").Select

Selection.Copy

Range("B49").Select

ActiveSheet.Paste

Range("B50").Select

ActiveSheet.Paste

Range("B51").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=-36

Range("E2").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-4],RC[-3])"

Range("E2").Select

Selection.AutoFill Destination:=Range("E2:E51"), Type:=xlFillDefault

Range("E2:E51").Select

ActiveWindow.SmallScroll Down:=-27

Range("L2").Select

ActiveCell.FormulaR1C1 = "='import détail morpho'!RC[-11]"

Range("L2").Select

Selection.AutoFill Destination:=Range("L2:O2"), Type:=xlFillDefault

Range("L2:O2").Select

Selection.AutoFill Destination:=Range("L2:O51"), Type:=xlFillDefault

Range("L2:O51").Select

ActiveWindow.SmallScroll Down:=-21

Range("B2").Select

Selection.Copy

Range("Q2").Select

ActiveSheet.Paste

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "MISE EN CASSETTE"

Range("R2").Select

ActiveCell.FormulaR1C1 = "Blocs"

Range("Q3").Select

Columns("Q:Q").EntireColumn.AutoFit

Range("B7").Select

Selection.Copy

Range("Q3").Select

ActiveSheet.Paste

Range("R2").Select

Application.CutCopyMode = False

Selection.Copy

Range("R3").Select

ActiveSheet.Paste

Range("B12").Select

Application.CutCopyMode = False

Selection.Copy

Range("Q4").Select

ActiveSheet.Paste

Range("R3").Select

Application.CutCopyMode = False

Selection.Copy

Range("R4").Select

ActiveSheet.Paste

Range("B17").Select

Application.CutCopyMode = False

Selection.Copy

Range("Q5").Select

ActiveSheet.Paste

Range("R5").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "Lames"

Range("B22").Select

Selection.Copy

Range("Q6").Select

ActiveSheet.Paste

Range("B27").Select

Application.CutCopyMode = False

Selection.Copy

Range("Q7").Select

ActiveSheet.Paste

Range("B32").Select

Application.CutCopyMode = False

Selection.Copy

Range("Q8").Select

ActiveSheet.Paste

Range("B37").Select

Application.CutCopyMode = False

Selection.Copy

Range("Q9").Select

ActiveSheet.Paste

Range("B42").Select

Application.CutCopyMode = False

Selection.Copy

Range("Q10").Select

ActiveSheet.Paste

Range("B47").Select

Application.CutCopyMode = False

Selection.Copy

Range("Q11").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=-6

Range("R5").Select

Application.CutCopyMode = False

Selection.Copy

Range("R6").Select

ActiveSheet.Paste

Range("R7").Select

ActiveSheet.Paste

Range("R8").Select

ActiveSheet.Paste

Range("R9").Select

ActiveSheet.Paste

Range("R10").Select

ActiveSheet.Paste

Range("R11").Select

ActiveSheet.Paste

Columns("N:N").Select

Application.CutCopyMode = False

Selection.NumberFormat = "0.00"

Selection.NumberFormat = "0.0"

Selection.NumberFormat = "0"

Range("P2").Select

ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-4],RC[-3])"

Range("P2").Select

Selection.AutoFill Destination:=Range("P2:P51"), Type:=xlFillDefault

Range("P2:P51").Select

ActiveWindow.SmallScroll Down:=-21

Columns("P:P").Select

Selection.Cut

Columns("K:K").Select

ActiveSheet.Paste

Range("C2").Select

ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[2],C[8]:C[12],4,0),0)"

Range("C2").Select

Selection.AutoFill Destination:=Range("C2:C51"), Type:=xlFillDefault

Range("C2:C51").Select

ActiveWindow.SmallScroll Down:=-21

Range("D2").Select

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],RC[13]:R[9]C[14],2,0)"

Range("D2").Select

Selection.AutoFill Destination:=Range("D2:D51"), Type:=xlFillDefault

Range("D2:D51").Select

ActiveWindow.SmallScroll Down:=-12

Range("D2").Select

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],R2C17:R11C18,2,0)"

Range("D2").Select

Selection.AutoFill Destination:=Range("D2:D51"), Type:=xlFillDefault

Range("D2:D51").Select

ActiveWindow.SmallScroll Down:=-15

Columns("E:E").Select

Selection.EntireColumn.Hidden = True

Columns("K:R").Select

Selection.EntireColumn.Hidden = True

ActiveWindow.SmallScroll Down:=6

Bonjour

Difficile de te répondre sans fichier excel joint avec 20 lignes significatives

Question, tes données sont elles dans une même colonne ? Comment ressort ton fichier de base brut ( extraction ?)

A priori et en fonction des réponses a ces questions il y a une solution à ton problème

Cordialement

FINDRH

Rechercher des sujets similaires à "ajout lignes absentes"