Boucle de mise à jour

Version imprimable

Bonjour à tous,

J'ai un dossier modèle qui contient un fichier Excel avec macro. Je souhaite renvoyer certaines informations de ce fichier dans un fichier récapitulatif. Donc j'ai fait une macro qui ajoute une nouvelle dans le fichier cible. C'est fonctionnel. En revanche, les informations peuvent être modifiées et je souhaiterai avoir une fonction de mise à jour des informations existantes dans mon fichiers récapitulatifs et si c'est un nouveau dossier alors, ça ajoute un nouvelle ligne:

Mon code:

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub MAJ()
Dim Chemin As String
Dim Chemin_complet As String
Dim Fic As String
Dim Cible As Workbook
Dim Source As Workbook
Dim i As Integer
Dim FirstRow As Long
Dim LastRow As Long
Dim Sini As String
 
 
Chemin = "P:\SINISTRES"
Fic = "Récapitulatif des sinistres.xlsm"
Chemin_complet = Chemin & "\" & Fic
 
 
Set Cible = Workbooks.Open(Chemin_complet)
Set Source = ThisWorkbook
Dossier = Source.Worksheets("Les_faits").Range("A9").Value
 
LastRow = Cible.Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Row
With Cible.Worksheets("Recap").Columns("A")
For i = 2 To LastRow
If Cells(i, 1) = Dossier Then
Cible.Worksheets("Recap").Range("A").Value = Source.Worksheets("Les_faits").Range("A9").Value
Cible.Worksheets("Recap").Range("B").Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
Cible.Worksheets("Recap").Range("C").Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
Cible.Worksheets("Recap").Range("D").Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
Cible.Worksheets("Recap").Range("E").Value = Source.Worksheets("Assurance").Range("M2").Value
    Else
LastRow = Cible.Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Row
Cible.Worksheets("Recap").Range("A" & LastRow + 1).Value = Source.Worksheets("Les_faits").Range("A9").Value
Cible.Worksheets("Recap").Range("B" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
Cible.Worksheets("Recap").Range("C" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
Cible.Worksheets("Recap").Range("D" & LastRow + 1).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
Cible.Worksheets("Recap").Range("E" & LastRow + 1).Value = Source.Worksheets("Assurance").Range("M2").Value
End If
 
Next i
Cible.Save
Cible.Close
ThisWorkbook.Save
ThisWorkbook.Close
End With
End Sub

Je n'ai pas d'erreur à l'exécution de la macro mais les infos ne remontent pas dans le fichier cible.

Merci d'avance de vos conseils avisés.

Cordialement,

Fred

28/04/2015, 19h26
parmi
Bonjour,

Ici
Code:

1 2 For i = 2 To LastRow If Cells(i, 1) = Dossier Then
Tu ne spécifies pas quel classeur et feuille pour Cells(i, 1).
Es-tu certain que c'est la bonne cellule ?

boucle mise à jour

Salut,

Même en spécifiant le fichier, je n'ai pas de résultat. La cells(i, 1) est bien la 2eme cellule de la colonne A, quand i = 2 to lastrow, c'est à dire la cellule ou la recherche doit commencer, non ? J'ai modifié le code, mais sans résultat. Et si la boucle ne fonctionne pas, je devrais au moins avoir le Else qui s'exécute. Si j'enlève la boucle, la copie entre les 2 classeurs fonctionnent et j'ai bien une nouvelle ligne qui s'ajoute à chaque fois.

Le code:

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub MAJ()
Dim Chemin As String
Dim Chemin_complet As String
Dim Fic As String
Dim Cible As Workbook
Dim Source As Workbook
Dim i As Integer
Dim FirstRow As Long
Dim LastRow As Long
Dim Sini As String
 
 
Chemin = "P:\SINISTRES"
Fic = "Récapitulatif des sinistres.xlsm"
Chemin_complet = Chemin & "\" & Fic
 
 
Set Cible = Workbooks.Open(Chemin_complet)
Set Source = ThisWorkbook
Dossier = Source.Worksheets("Les_faits").Range("A9").Value
 
LastRow = Cible.Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Row
With Cible.Worksheets("Recap").Cells(LastRow, "A")
For i = 2 To LastRow
If Cible.Worksheets("Recap").Cells(i, 1) = Dossier Then
'Cible.Worksheets("Recap").Range("A").Value = Source.Worksheets("Les_faits").Range("A9").Value
Cible.Worksheets("Recap").Range("B").Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
Cible.Worksheets("Recap").Range("C").Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
Cible.Worksheets("Recap").Range("D").Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
Cible.Worksheets("Recap").Range("E").Value = Source.Worksheets("Assurance").Range("M2").Value
    Else
LastRow = Cible.Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Row
Cible.Worksheets("Recap").Range("A" & LastRow + 1).Value = Source.Worksheets("Les_faits").Range("A9").Value
Cible.Worksheets("Recap").Range("B" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
Cible.Worksheets("Recap").Range("C" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
Cible.Worksheets("Recap").Range("D" & LastRow + 1).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
Cible.Worksheets("Recap").Range("E" & LastRow + 1).Value = Source.Worksheets("Assurance").Range("M2").Value
End If
 
Next i
Cible.Save
Cible.Close
ThisWorkbook.Save
ThisWorkbook.Close
End With
End Sub

Voilà, voilà, j'apprends, j'essaie et j'essaie encore mais...

Cordialement,

Fred

Et si on y allait comme ceci ?
Le With...End With sert à ne pas répéter des parties de codes pour rien...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
With Cible.Worksheets("Recap")
 
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow
   If .Cells(i, 1) = Dossier Then
      .Range("A" & LastRow + 1).Value = Dossier
      .Range("B" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
      .Range("C" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
      .Range("D" & LastRow + 1).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
      .Range("E" & LastRow + 1).Value = Source.Worksheets("Assurance").Range("M2").Value
   Else
      .Range("A" & LastRow + 1).Value = Dossier
      .Range("B" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
      .Range("C" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
      .Range("D" & LastRow + 1).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
      .Range("E" & LastRow + 1).Value = Source.Worksheets("Assurance").Range("M2").Value
   End If
Next
End With

Il manquait: & LastRow + 1 à ta 1ere partie

Bonjour,

Si j'ai bien compris :

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
Sub MAJ()
Dim Chemin As String, Chemin_complet As String, Fic As String, Sini As String, Dossier As String
Dim Cible As Workbook, Source As Workbook
Dim FirstRow As Long, LastRow As Long, i As Long
Dim C As Range
    Chemin = "P:\SINISTRES"
    Fic = "Récapitulatif des sinistres.xlsm"
    Chemin_complet = Chemin & "\" & Fic
    Set Cible = Workbooks.Open(Chemin_complet)
    Set Source = ThisWorkbook
    Dossier = Source.Worksheets("Les_faits").Range("A9").Value
    With Cible.Worksheets("Recap")
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set C = .Columns("A").Find(Dossier, , xlValues, xlWhole)
        If Not C Is Nothing Then
            C.Offset(0, 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
            C.Offset(0, 2).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
            C.Offset(0, 3).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
            C.Offset(0, 4).Value = Source.Worksheets("Assurance").Range("M2").Value
        Else
            LastRow = Cible.Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Row
            .Range("A" & LastRow + 1).Value = Source.Worksheets("Les_faits").Range("A9").Value
            .Range("B" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
            .Range("C" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
            .Range("D" & LastRow + 1).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
            .Range("E" & LastRow + 1).Value = Source.Worksheets("Assurance").Range("M2").Value
        End If
    End With
    Cible.Close SaveChanges:=True
    ThisWorkbook.Close SaveChanges:=True
End Sub

Cordialement.

2 pièce(s) jointe(s)

boucle mise à jour

En effet, le code est plus léger ainsi mais toujours pas de résultat alors qu'il n'y a pas d'erreur. J'ai fait une petite modif car la boucle doit permettre de réécrire une ligne existante et le else d'ajouter une nouvelle ligne.

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub MAJ()
Dim Chemin As String
Dim Chemin_complet As String
Dim Fic As String
Dim Cible As Workbook
Dim Source As Workbook
Dim i As Integer
Dim FirstRow As Long
Dim LastRow As Long
Dim Sini As String
 
 
Chemin = "P:\SINISTRES"
Fic = "Récapitulatif des sinistres.xlsm"
Chemin_complet = Chemin & "\" & Fic
 
 
Set Cible = Workbooks.Open(Chemin_complet)
Set Source = ThisWorkbook
Dossier = Source.Worksheets("Les_faits").Range("A9").Value
 
 
With Cible.Worksheets("Recap")
 
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow
   If .Cells(i, 1) = Dossier Then
      .Cells(i, 1).Value = Dossier
      .Cells(i, 2).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
      .Cells(i, 3).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
      .Cells(i, 4).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
      .Cells(i, 5).Value = Source.Worksheets("Assurance").Range("M2").Value
   Else
      .Range("A" & LastRow + 1).Value = Dossier
      .Range("B" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
      .Range("C" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
      .Range("D" & LastRow + 1).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
      .Range("E" & LastRow + 1).Value = Source.Worksheets("Assurance").Range("M2").Value
   End If
Next
End With
Cible.Save
Cible.Close
ThisWorkbook.Save
ThisWorkbook.Close
 
End Sub

Pour que ce soit plus simple, je me permets de te glisser les 2 fichiers en question.

Pièce jointe 176395 Pièce jointe 176396

Je vois si avec une autre fonction find ou recherchev ça le fait.

Cordialement,

Fred

Modification de ma partie

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
With Cible.Worksheets("Recap")
 
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow
   If .Cells(i, 1) = Dossier Then
      .Range("A" & i).Value = Dossier
      .Range("B" & i).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
      .Range("C" & i).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
      .Range("D" & i).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
      .Range("E" & i).Value = Source.Worksheets("Assurance").Range("M2").Value
   Else
      .Range("A" & LastRow + 1).Value = Dossier
      .Range("B" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
      .Range("C" & LastRow + 1).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
      .Range("D" & LastRow + 1).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
      .Range("E" & LastRow + 1).Value = Source.Worksheets("Assurance").Range("M2").Value
   End If
Next
End With

29/04/2015, 12h17
Fred_rt

Boucle de mise à jour

Salut,

Merci à vous. Et gFZT82, en effet, tu as parfaitement compris.

Cela fonctionne nickel. Je viens d'apprendre un nouveau truc :P

Très cordialement,

Fred