Boucle de mise à jour

**Fred_rt** · 28/04/2015, 17h20

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 :

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
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

**parmi** · 28/04/2015, 19h26

Bonjour,

Ici

Code :

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

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 ?

**Fred_rt** · 29/04/2015, 10h59

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 :

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
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

**parmi** · 29/04/2015, 11h18

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

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
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

**gFZT82** · 29/04/2015, 11h50

Bonjour,

Si j'ai bien compris :

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
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.

**Fred_rt** · 29/04/2015, 12h08

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 :

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
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.

Fiche suivi de sinistre.xlsm Récapitulatif des sinistres.xlsm

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

Cordialement,

Fred

**parmi** · 29/04/2015, 12h14

Modification de ma partie

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
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

**Fred_rt** · 29/04/2015, 12h17

Salut,

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

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

Très cordialement,

Fred

Boucle de mise à jour [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager