Pb macro Centralisation

Version imprimable

Bonjour,

Je souhaite réaliser une macro rapatriant des données de fichier de même forme. Je ne comprends pas pourquoi la macro plante (test avec deux classeur), si quelqu'un peut m'aider je le remercie d'avance!

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
48
49
50
51
52
53
54
55
56
 
Sub Restitution()
 
'Zone de déclaration des variables
Dim Chemin1 As String, Chemin2 As String 'Chemin du fichier en entier
Dim Classeur1 As String, Classeur2 As String 'Classeur Source
Dim FeuilleD As String 'Feuille Destination
Dim FD As Worksheet, FS As Worksheet 'Feuille Actuel (en général "Feuil1")
Dim NBligne As Long, NBcolonne As Long, i As Long, j As Long, compteur As Long
Dim WB As Workbook
Dim NomClasseur As String, NBclasseur As Long
 
'Zone d'initialisation
FeuilleD = "Feuil1"
Chemin1 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1110_Fichier_assures_gestion_des_droits_de_base.xls"
Classeur1 = "1110_Fichier_assures_gestion_des_droits_de_base.xls"
Chemin2 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1140_CMU_de_base.xls"
Classeur2 = "1140_CMU_de_base.xls"
NBclasseur = 2
'Début de la macro
Set WD = Workbooks("Restitution_historique.xls")
Set FD = Workbooks("Restitution_historique.xls").Worksheets(FeuilleD)
Workbooks.Open (Chemin1)
Workbooks.Open (Chemin2)
 
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
ActiveWindow.Visible = False
End If
 
NomClasseurD = WD.Name
compteur = 1
 
For Each WB In Workbooks
    NomClasseur = WB.Name
    If NomClasseur <> NomClasseurD Then
    Set FS = Worksheets("Commentaire")
        With FS
            NBligne = .Cells(.Rows.Count, 3).End(xlUp).Row
            NBcolonne = .Cells(2, .Columns.Count).End(xlToLeft).Column
        End With
 
 
            For i = 3 To NBligne
                compteur = compteur + 1
                FD.Cells(compteur, 1).Value = FS.Cells(2, 1).Value
                FD.Cells(compteur, 2).Value = FS.Cells(2, 2).Value
                FD.Cells(compteur, 3).Value = FS.Cells(i, 3).Value
                FD.Cells(compteur, 4).Value = FS.Cells(i, 4).Value
            Next
		WB.close
    End If
Next
Workbooks(Classeur1).Close False
Workbooks(Classeur2).Close False
 
End Sub

12/10/2012, 09h44
fring

Bonjour,

Quel est le message d'erreur et sur quelle ligne de code se produit l'erreur ?
12/10/2012, 09h45
issoram

Bonjour,

ça plante sur quelle ligne?, quel message d'erreur?
N'oublie pas ce type d'infos, c'est beaucoup plus simple de t'aider ensuite.

A la ligne 53 (et 54) tu essaies de fermer un classeur déjà fermé

Essaies comme ceci (pas testé)

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
Sub Restitution(ByVal Chemin As String, Fichier As String, ByRef Ini As Long)
Dim Wb As Workbook
Dim FS As Worksheet, FD As Worksheet
Dim NbLigne As Long, i As Long
 
Application.ScreenUpdating = False
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
Fichier = Chemin & Fichier
If Dir(Fichier) <> "" Then
    Set Wb = Workbooks.Open(Fichier)
    Set FS = Wb.Worksheets("Commentaire")
    With FS
        NbLigne = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set FD = ThisWorkbook.Worksheets("Feuil1")
        For i = 3 To NbLigne
            FD.Cells(Ini + i - 1, 1).Value = .Cells(2, 1).Value
            FD.Cells(Ini + i - 1, 2).Value = .Cells(2, 2).Value
            FD.Cells(Ini + i - 1, 3).Value = .Cells(i, 3).Value
            FD.Cells(Ini + i - 1, 4).Value = .Cells(i, 4).Value
        Next i
        Ini = Ini + NbLigne - 2
    End With
    Set FD = Nothing
    Set FS = Nothing
    Wb.Close False
    Set Wb = Nothing
End If
End Sub
 
Sub Main()
Dim Chemin1 As String, Chemin2 As String, Classeur1 As String, Classeur2 As String
Dim X As Long
 
Application.ScreenUpdating = False
Chemin1 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1110_Fichier_assures_gestion_des_droits_de_base.xls"
Classeur1 = "1110_Fichier_assures_gestion_des_droits_de_base.xls"
Chemin2 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1140_CMU_de_base.xls"
Classeur2 = "1140_CMU_de_base.xls"
 
Restitution Chemin1, Classeur1, X
Restitution Chemin2, Classeur2, X
MsgBox "Traitement terminé..."
End Sub

12/10/2012, 10h23
niafron71
Bonjour,

Désolé pour le manque de précision. L'erreur ce produit à la ligne 35
Code:

1 2 Set FS = Worksheets("Commentaire")
avec le message d'erreur "l'indice n'appartient pas à la selection". En fait je ne comprends pas pourquoi il ne passe pas au classeur suivant...
12/10/2012, 10h59
mercatog

Quand tu travailles avec plusieurs classeur, il faudra écrire comme suit sans se soucier du classeur actif (dans ton cas le dernier ouvert)

Code:

Set FS=Wbk.Worksheets("Feuil1") 'Avec Wbk la variable contenant l'objet classeur

Je venais juste aussi de trouver l'erreur! Je met le code pour que cela puisse servir à quelqu'un d'autre.

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
48
49
50
51
52
53
Sub Restitution()
 
'Zone de déclaration des variables
Dim Chemin1 As String, Chemin2 As String 'Chemin du fichier en entier
Dim Classeur1 As String, Classeur2 As String 'Classeur Source
Dim FeuilleD As String 'Feuille Destination
Dim FD As Worksheet, FS As Worksheet 'Feuille Actuel (en général "Feuil1")
Dim NBligne As Long, NBcolonne As Long, i As Long, j As Long, compteur As Long
Dim WB As Workbook
Dim NomClasseur As String, NBclasseur As Long
 
'Zone d'initialisation
FeuilleD = "Feuil1"
Chemin1 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1110_Fichier_assures_gestion_des_droits_de_base.xls"
Classeur1 = "1110_Fichier_assures_gestion_des_droits_de_base.xls"
Chemin2 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1140_CMU_de_base.xls"
Classeur2 = "1140_CMU_de_base.xls"
NBclasseur = 2
'Début de la macro
Set WD = Workbooks("Restitution_historique.xls")
Set FD = Workbooks("Restitution_historique.xls").Worksheets(FeuilleD)
Workbooks.Open (Chemin1)
Workbooks.Open (Chemin2)
 
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
ActiveWindow.Visible = False
End If
 
NomClasseurD = WD.Name
compteur = 1
 
For Each WB In Workbooks
    NomClasseur = WB.Name
    If NomClasseur <> NomClasseurD Then
    Set FS = WB.Worksheets("Commentaire")
        With FS
            NBligne = .Cells(.Rows.Count, 3).End(xlUp).Row
            NBcolonne = .Cells(2, .Columns.Count).End(xlToLeft).Column
        End With
 
 
            For i = 3 To NBligne
                compteur = compteur + 1
                FD.Cells(compteur, 1).Value = FS.Cells(2, 1).Value
                FD.Cells(compteur, 2).Value = FS.Cells(2, 2).Value
                FD.Cells(compteur, 3).Value = FS.Cells(i, 3).Value
                FD.Cells(compteur, 4).Value = FS.Cells(i, 4).Value
            Next
            WB.Close False
    End If
Next
 
End Sub

Je vous remercie pour votre aide et votre rapidité!

12/10/2012, 11h30
mercatog
As tu testé le code proposé en #4
Car pour ton code, j'ai des réticences personnelles que plusieurs pourront partager.
Tu ouvres tes fichiers par
Code:

1 2 Workbooks.open tonFichier1 Workbooks.open tonFichier2
Ensuite tu parcours tous les fichiers ouverts et tu testes si le fichier WB n'est pas le fichier contenant la macro..etc

C'est un peu tordu comme approche (excusez le terme).En plus, supposes que tu as un 4ème classeur sans relation d'ouvert dans la même instance Excel... Avec ta méthode tu iras droit vers le mur.

Il vaudrait mieux instancier les classeurs dès leur ouverture par des variables objet Workbook. Ensuite, tu travailles avec ces variables sans souci et sans boucler sur tous les classeurs ouverts.

Exemple
Code:

1 2 3 4 Dim WB1 As WorkBook, WB2 As WorkBook '..... Set WB1=Workbooks.open(tonFichier1) Set WB2=Workbooks.open(tonFichier2)
Désormais WB1.Worksheets("Feuil1") fait référence à la feuille Feuil1 de tonFichier1 et WB2.Worksheets("Toto") fait référence à la feuille Toto de tonFichier2.