Code VBA je plante

Bonjour.

je sèche sur un projet VBA(nuit et jours, tout mon congé y est passé).
J'aurais souhaité me targuer d'être passé du côté des pro Excel mais je démarre vraiment pas avec VBA.

J'ai un fichier qui doit faire la récap d'autres fichiers ayant une structure à l'identique exacte, seuls le nombre d'onglets peut varier d'un fichier à l'autre.
L'idée ici est de ne récupérer que les informations qui intéressent dans l'onglet "compil" du fichier récap.
le fichier récap n'a que 2 onglets "str.cts" et "compil".
"str.cts" me permet de générer manuellement certains éléments utilisés comme variable dans ma macro.

Voici ce que j'ai essayé de bidouiller après des heures de lecture et de visionnage de tutos:

Sub Synthese()
'Ouvrir fichiers concernés, déclarations des variables

Dim i As Integer
Dim j As Integer
Dim k As Long
Dim n As Integer
Dim Chemin As String
Dim Statut As String
Dim Nfchier As String
Dim Srce As Worksheet
Dim ShtCible As Worksheet
Dim Datasrce As Workbook
Dim Cible As Workbook

Set Srce = Worksheets("Str.Cts")
For i = 1 To 47
Chemin = Srce.Cells(i + 3, 3).Value
Statut = Srce.Cells(i + 3, 4).Value
Nfchier = Srce.Cells(i + 3, 2).Value

'Test pour savoir quel fichier ouvrir
If Chemin <> "" And Statut = "" Then<code basic>
Application.Workbooks.Open Chemin

End If

Next

'Le classeur actif devient celui qui vient d'être ouvert
'il faut compter le nombre feuilles et pour chacune alimenter la ligne
'correspondante dans la feuille compil du classeur récap

Set Cible = ThisWorkbook

Set ShtCible = Cible.Worksheets("Compil")

Dim ShtDatasrce As Worksheet

n = Datasrce.Sheets.Count
k = ShtCible.Cells(Rows.Count, "C").End(xlUp).Row + 1

For j = 1 To n

With ShtCible
Set ShtDatasrce = Datasrce.Worksheets(j)
ShtCible.Cells(k, "C") = ShtDatasrce.Name
ShtCible.Cells(k, "D") = ShtDatasrce.Cells(2, "A")
ShtCible.Cells(k, "F") = ShtDatasrce.Cells(4, "C")
ShtCible.Cells(k, "J") = ShtDatasrce.Cells(2, "C")
ShtCible.Cells(k, "K") = ShtDatasrce.Cells(2, "E")
ShtCible.Cells(k, "L") = ShtDatasrce.Cells(2, "G")
ShtCible.Cells(k, "N") = ShtDatasrce.Cells(2, "I")
ShtCible.Cells(k, "O") = ShtDatasrce.Cells(5, "I")
ShtCible.Cells(k, "P") = ShtDatasrce.Cells(6, "I")
ShtCible.Cells(k, "Q") = ShtDatasrce.Cells(7, "I")
ShtCible.Cells(k, "R") = ShtDatasrce.Cells(8, "I")

End With

Next

End Sub


L'idée est que si mon classeur source "str.cts" a n feuilles , que la macro me génère n lignes supplémentaires d'enregistrement sur la feuille compil, à partir de la dernière ligne non vide.

Le must serait qu'aaprès avoir renseigné les champs comme il faut, la marco ferme le classeur source, et verouille les derniers nregistrements contre toute modification hasardeuse.

5 réponses

  1. Re,
    Ah ben là, oui des lacunes
    dans ce bout de code
    Set Cible = ThisWorkbook
            Set ShtCible = Cible.Worksheets("Compil")
                      
            n = Datasrce.Sheets.Count
            k = ShtCible.Cells(Rows.Count, "C").End(xlUp).Row + 1
              For j = 1 To n

    Set Cible --> tu initialise le classeur avec la variable cible
    n= --> tu initialise la variable n
    idem pour k
    for j=1 --> tu initialise j à 1 jusqu'à la variable n

    comme ta variable Datasrce n'est pas initialise, le programme BUG
    0
    1. qu'est ce que "initialiser" comment pourrais je procéder pour résoudre cela ?
      0
      1. Re,
        Normal, Datasrce n'est pas initialisé et sans classeur modèle ??
        0
        1. bonjour !

          super sympa de si bonne heure.

          le code plante à la ligne n°34:

          n = Datasrce.Sheets.Count

          0
          1. Bonjour,
            Sans être sur, à tester
            Sub Synthese()
            'Ouvrir fichiers concernés, déclarations des variables
                
                Dim i As Integer
                Dim j As Integer
                Dim k As Long
                Dim n As Integer
                Dim Chemin As String
                Dim Statut As String
                Dim Nfchier As String
                Dim Srce As Worksheet
                Dim ShtCible As Worksheet
                Dim Datasrce As Workbook
                Dim Cible As Workbook
                Dim ShtDatasrce As Worksheet
                
                Set Srce = Worksheets("Str.Cts")
                For i = 1 To 47
                  Chemin = Srce.Cells(i + 3, 3).Value
                  Statut = Srce.Cells(i + 3, 4).Value
                  Nfchier = Srce.Cells(i + 3, 2).Value
                  
                  'Test pour savoir quel fichier ouvrir
                  If Chemin <> "" And Statut = "" Then '<code basic>
                    Application.Workbooks.Open Chemin
                   
                    'Le classeur actif devient celui qui vient d'être ouvert
                    'il faut compter le  nombre feuilles et pour chacune alimenter la ligne
                    'correspondante dans la feuille compil du classeur récap
                        
                    Set Cible = ThisWorkbook
                    Set ShtCible = Cible.Worksheets("Compil")
                              
                    n = Datasrce.Sheets.Count
                    k = ShtCible.Cells(Rows.Count, "C").End(xlUp).Row + 1
                      For j = 1 To n
                        With ShtCible
                          Set ShtDatasrce = Datasrce.Worksheets(j)
                          ShtCible.Cells(k, "C") = ShtDatasrce.Name
                          ShtCible.Cells(k, "D") = ShtDatasrce.Cells(2, "A")
                          ShtCible.Cells(k, "F") = ShtDatasrce.Cells(4, "C")
                          ShtCible.Cells(k, "J") = ShtDatasrce.Cells(2, "C")
                          ShtCible.Cells(k, "K") = ShtDatasrce.Cells(2, "E")
                          ShtCible.Cells(k, "L") = ShtDatasrce.Cells(2, "G")
                          ShtCible.Cells(k, "N") = ShtDatasrce.Cells(2, "I")
                          ShtCible.Cells(k, "O") = ShtDatasrce.Cells(5, "I")
                          ShtCible.Cells(k, "P") = ShtDatasrce.Cells(6, "I")
                          ShtCible.Cells(k, "Q") = ShtDatasrce.Cells(7, "I")
                          ShtCible.Cells(k, "R") = ShtDatasrce.Cells(8, "I")
                        End With
                        k = k + 1
                        Set ShtDatasrce = Nothing
                      Next j
                      ThisWorkbook.Close
                    End If
                  Next i
            End Sub
            0