fichier de récap

Version imprimable

23/04/2015, 11h50
Fred_rt

fichier de récap

Bonjour à tous,

Voilà mon problème:
J'ai un dossier modèle qui contient divers fichiers Office (modèle de courrier Word, Excel etc). Le document de travail est un fichier Excel. Je souhaite ajouter un joli bouton du genre "mise à jour" qui va envoyer certaines informations dans un autre classeur Excel "récap".
Il faudrait qu'une ligne soit ajoutée pour chaque nouveau dossier et également que la macro prenne en compte l'existence d'un dossier existant pour mettre les infos à jour.

Envoyer des donnes dans un autre fichier, je peux le faire mais j'avoue que l'intégralité des fonctions que je recherche est un peu en dehors de mes compétences en VBA.

Comment puis-je m'y prendre ?

En vous remerciant par avance de toutes vos suggestions.

Cordialement,

Fred

fichier de récap

Hello,

Bon voilà où j'en suis:

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
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
 
Chemin = "P:\SINISTRES"
Fic = "Récapitulatif des sinistres.xlsm"
Chemin_complet = Chemin & "\" & Fic
 
Set Cible = Workbooks.Open(Chemin_complet)
Set Source = ThisWorkbook
 
i = i + 1
For i = 2 To lastline
Cible.Worksheets("Recap").Cells(1, i).Value = Source.Worksheets("Les_faits").Range("A9").Value
Cible.Worksheets("Recap").Cells(2, i).Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
Cible.Worksheets("Recap").Cells(3, i).Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
Cible.Worksheets("Recap").Cells(4, i).Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
Cible.Worksheets("Recap").Cells(5, i).Value = Source.Worksheets("Assurance").Range("M2").Value
Next i
 
Cible.Save
Cible.Close
 
End Sub

Lorsque j'exécute cette macro, je n'ai pas d'erreur. En revanche, cela n'ajoute pas de ligne à mon fichier cible. J'imagine une mauvaise utilisation de la boucle for. Mon premier code était:

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
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
 
Chemin = "P:\SINISTRES"
Fic = "Récapitulatif des sinistres.xlsm"
Chemin_complet = Chemin & "\" & Fic
 
Set Cible = Workbooks.Open(Chemin_complet)
Set Source = ThisWorkbook
 
Cible.Worksheets("Recap").Range("A2").Value = Source.Worksheets("Les_faits").Range("A9").Value
Cible.Worksheets("Recap").Range("B2").Value = Source.Worksheets("Résultat_enquête").Range("A2").Value
Cible.Worksheets("Recap").Range("C2").Value = Source.Worksheets("Résultat_enquête").Range("D2").Value
Cible.Worksheets("Recap").Range("D2").Value = Source.Worksheets("Suivi_courrier").Range("E6").Value
Cible.Worksheets("Recap").Range("E2").Value = Source.Worksheets("Assurance").Range("M2").Value
 
Cible.Save
Cible.Close
 
End Sub

Celui fonctionne mais écrase à chaque fois la ligne existante.
Qu'ai je mal fait ?

Merci d'avance.

Cordialement,

Fred

Salut, il faudrait rajouter qqch du genre :
Code:

1 2 3 4 5 Dim LastRow As Long LastRow = Cible.Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Row Cible.Worksheets("Recap").Range("A" & LastRow + 1).Value = "....." Cible.Worksheets("Recap").Range("B" & LastRow + 1).Value = "....." etc ...
à l'endroit idoine dans ton code.

Sinon lire le tutoriel de Joël : Dernière ligne et la dernière colonne renseignées d'une feuille

24/04/2015, 18h00
Fred_rt

fichier de récap

Salut Kiki29,

C'est nickel.

Je te remercie.

Cordialement,

Fred

fichier de récap

Bonjour,

J'ai voulu ajouté la vérification d'une valeur pour mettre la ligne à jour si cette valeur existe, sinon, on ajoute une ligne au fichier.
Voici 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
 
Dossier = Source.Worksheets("Les_faits").Range("A9").Value
Chemin = "P:\SINISTRES"
Fic = "Récapitulatif des sinistres.xlsm"
Chemin_complet = Chemin & "\" & Fic
 
ThisWorkbook.Save
Set Cible = Workbooks.Open(Chemin_complet)
Set Source = ThisWorkbook
 
FirstRow = Cible.Worksheets("Recap").UsedRange.Cells(1).Row
LastRow = Cible.Worksheets("Recap").Range("A" & Rows.Count).End(xlUp).Row
For LastRow = LastRow To FirstRow Step -1
     With Cible.Cells(LastRow, Dossier)
        If Not IsError(.Value) Then
                    If .Value = Dossier Then
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
                    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
    End With
Next Lrow
Cible.Save
Cible.Close
ThisWorkbook.Close
End Sub

Je ne sais pas encore si le code fonctionne parce que j'ai une erreur à la ligne 40 "end with sans with". Pourtant j'ai bien mis un With à la ligne 24.

Merci d'avance.

Cordialement,

Fred

27/04/2015, 13h48
Marc-L

Bonjour, bonjour !

Deux lignes If dans le code mais une seule ligne End If ‼

_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

fichier de récap

Salut,

Voici le code qui ne me retourne aucune erreur, en revanche il n'implémente pas mon fichier récapitulatif. J'ai tendance à penser que la boucle if ne fait le job espéré ou plus vraisemblablement, j'ai mal codé tout ça:

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
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
 
ThisWorkbook.Save
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 Cells(i, 1) = Dossier Then
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
    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.Close
End With
End Sub

D'un autre côté j'ai remarqué que quand j'utilise Cells, ça ne fonctionne pas comme espéré...
Je suis ouvert à tous commentaires, critiques, suggestions etc...

Cordialement,

Fred