Discussion :

[ElPibeOro]

Bonjour,
J'ai un fichier que je met en pièces-jointes avec deux feuilles :
- Feuille1 (la feuille automatisée ou je ne remplit rien et qui correspond à la feuille "Investissement" dans le code VBA.
- Feuille2 (la feuille où je remplit les données et qui doit alimenter la feuille1, Feuille2 correspond à "Centre Agglo Investissement dans mon code).

Il faudrait donc que la personne aille remplir les données dans la Feuille2. Il remplit donc entièrement la ligne et choisi par exemple le programme "Renforcement de Chaussée" en colonne B.
Ensuite il clique sur un bouton qui copie la ligne dans la Feuille1 à la suite de la ligne de titre du programme "Renforcement de Chaussée".
Evidemment si il saisit dans la feuille2 une autre opération avec un programme différent, cette ligne devra se copier sous ce programme dans la feuille1.
J'espère avoir été assez clair...c'est compliqué à bien expliquer !

Je vais essayer d'être plus clair en donnant un exemple.e viens donc de remplir deux lignes (lignes 5 et 6) en Feuille2.
La ligne 5 est une opération de type "Protection contre les Risques Naturels" (voir colonne B).
Je clique sur le bouton qui contient ma macro et je voudrais que celle-ci copie la ligne que je viens de remplir et l'envoi dans la feuille1 sous la ligne "Protection contre les Risques Naturels" donc ligne 4.
De même, l'autre opération que j'ai rempli dans la Feuille2 est de type "Etudes", je voudrais que la macro la copie dans la Feuille1 dessous "Etudes donc en ligne 7.

Le code fonctionne mais les lignes n'apparaissent pas toujours sous le bon programme en Feuille1

Voici mon programme :

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
Sub ALIMENTER()
Dim MonProgramme As String
Dim Feuille_Source As Worksheet
Set Feuille_Source = Worksheets("Centre Agglo Investissement")
Dim Feuille_Cible As Worksheet
Set Feuille_Cible = Worksheets("Investissement")
Dim lig As Long
Dim derlig As Long, ligne_Fin As Long
Dim end_Line As Long
 
derlig = Feuille_Source.Range("B" & Feuille_Source.Rows.Count).End(xlUp).Row
 
For lig = 5 To derlig
 Feuille_Source.Activate
    MonProgramme = Trim(Feuille_Source.Cells(lig, 2).Value)
    Feuille_Source.Range(Feuille_Source.Cells(lig, 2), Feuille_Source.Cells(lig, 32)).Copy
 Feuille_Cible.Activate
 
 
                    ligne_Fin = Feuille_Cible.Range("b" & Feuille_Cible.Rows.Count).End(xlUp).Row
                        Set R = Feuille_Source.Range("b:b").Find(MonProgramme)
                        If Not R Is Nothing Then
                            ligneDeb = R.Row
 
                            nbVal = Application.WorksheetFunction.CountIf(Feuille_Cible.Range(Cells(ligneDeb, 2), Feuille_Cible.Cells(ligne_Fin, 2)), MonProgramme) - 1
                            end_Line = ligneDeb + nbVal
                            Feuille_Cible.Cells(end_Line + 1, 2).Select
                            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        End If
                           Application.CutCopyMode = False
 
Next lig
 
End Sub

Merci d'avance pour votre aide !

[Invité]

Bonjour,

Voici un code fonctionnant par rapport à ce que vous avez écrit

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
Sub Alimenter()
 
Dim MonProgramme As String
 
Dim ShSource As Worksheet
Dim ShCible As Worksheet
 
Dim Cellule As Range
 
Dim LigneDeTitreSource As Long
Dim LigneDeTitreCible As Long
Dim DerniereLigneCible As Long
Dim DerniereLigneProgramme As Long
Dim LigneEnCours As Long
Dim DerniereLigneSource As Long
Dim J As Long
 
 
 Set ShSource = Worksheets("Centre Agglo Investissement")
 Set ShCible = Worksheets("Investissement")
 LigneDeTitreCible = 5
 
 
 LigneDeTitreSource = 4
 LigneEnCours = LigneDeTitreSource + 1
 
 
 DerniereLigneSource = Cells(ShSource.Rows.Count, 2).End(xlUp).Row
 
 For LigneEnCours = LigneDeTitreSource + 1 To DerniereLigneSource
 
    ShSource.Activate
    MonProgramme = Cells(LigneEnCours, 2)
 
    ShCible.Activate
    DerniereLigneCible = Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row
 
 
    ' Recherche de la dernière ligne du programme dans la colonne B de la feuille Cible
    DerniereLigneProgramme = 0
    Range(Cells(LigneDeTitreCible + 1, 2), Cells(DerniereLigneCible, 2)).Select
 
    For Each Cellule In Selection
        Select Case Cellule
                Case MonProgramme
                  DerniereLigneProgramme = Cellule.Row
        End Select
    Next Cellule
 
    ' Si le nom du programme est reconnu alors on insere une ligne après la dernière ligne du programme
    If DerniereLigneProgramme > 0 Then
            Rows(DerniereLigneProgramme + 1).Select
 
            Rows(DerniereLigneProgramme + 1).Insert Shift:=xlDown
            Cells(DerniereLigneProgramme + 1, 2).Select
 
            ' On duplique les colonnes dans la feuille cible
            With Cells(DerniereLigneProgramme + 1, 2)
                For J = 2 To 32
                    With Cells(DerniereLigneProgramme + 1, J)
                        .Value = ShSource.Cells(LigneEnCours, J)
                        .Interior.Color = 65535  ' Les couleurs sont mises en jaune pour la compréhension du programme
                    End With
                Next J
            End With
            Application.CutCopyMode = False
    End If
 
 Next LigneEnCours
 
Set ShSource = Nothing
Set ShCible = Nothing
 
End Sub

Le code est dans le fichier joint.

Cordialement.