Créer une base de donnée qui consolide plusieurs onglets de plusieurs fichiers - VBA

  • Auteur de la discussion cachou91
  • Date de début
C

cachou91

Nouveau membre
Bonjour à tous,

Je suis nouvelle sur le forum et j'ai besoin de votre aide car je ne connais pas le langage VBA.
J'ai récupéré une macro, qui ne donne pas de message d'erreur mais qui ne fonctionne pas...

Je voudrais copier coller dans un fichier conso plusieurs onglets de plusieurs fichiers (qui ont tous le même format).

Ci-dessous le code :

Code: 
Sub conso_files()

    Dim f As FileDialog
    Dim chemins As Variant, path As Variant, tableau As Variant, selectedFiles As Variant
    Dim wb As Workbook, sh As Worksheet
    Dim i As Integer, files_last_col As Integer
    Dim files_last_row As Long, db_last_row As Long
    
    Dim check As Boolean
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    With db = "Feuil1"
    End With
   

    'userform pour choisir le dossier
    Set f = Application.FileDialog(msoFileDialogFilePicker)
    
    With f
        
        .Filters.Clear
        .Filters.Add "Classeur Excel", "*.xls; *.xlsx; *.xlsm", 1
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.path
        
        If .Show = -1 Then
            j = 1
            ReDim tableau(1 To .SelectedItems.Count, 1 To 1)
            For Each selectedFiles In .SelectedItems
                tableau(j, 1) = selectedFiles
                j = j + 1
            Next
        End If
        
    End With
    
    If IsEmpty(tableau) Then GoTo fin
    If Not Cancelled Then chemins = tableau
    
    'boucle sur les fichiers à consolider
    For Each path In chemins
               
        'on ouvre le fichier à consolider
        Application.StatusBar = "Importing " & Dir(path) & "..."
        Set wb = Application.Workbooks.Open(path, , True)
        DoEvents
    
        'boucle sur les onglets
        For Each sh In wb.Sheets
        
            With sh
        
                'si couleur d'onglet <> rouge ou range pays vide on sort de la boucle
                If .Tab.Color <> 255 Then GoTo next_sheet

                'on déprotège la feuille
                sh.Unprotect Password:="clemence"

                'on défiltre/démasque tout
                .AutoFilterMode = False
                .Range("A1").ClearOutline
                .Cells.UnMerge
                
                
                  With db_last_row = .Cells(Rows.Count, 1).End(xlUp).Row
                   End With
                   
                
                'on copie-colle la plage dans DB
                
                sh.Range("A1:AE492").Copy
                .Cells(lastrow + 1, 1).PasteSpecial xlValues
            
            End With
        
next_sheet:
        Next
        
        'on ferme le fichier
        Application.CutCopyMode = False
        wb.Close False
        DoEvents

    Next

    'on supprime les colonnes inutiles
    For i = files_last_col To 1 Step -1
        If db.Cells(1, i).Value = "" Then db.Columns(i).Delete
    Next
    
    
    MsgBox "Consolidation terminée !", vbInformation

fin:
    With Application
        .CutCopyMode = False
        .StatusBar = False
        
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub

Sub sdfds()

Application.StatusBar = False
End Sub


J'espère que vous pourrez m'aider et que je me suis bien expliquée

A bientot
 
drul

drul

Obscur pro du hardware
Staff
Salut,
Plein de variable non initialisé ou qui sorte de nulle part, des incohérences de type, des "with" vides, vraiment bizarre ton code, il vient d'ou ?
 
C

cachou91

Nouveau membre

Hello,

Merci pour ta réponse!

A la base c'était celui ci qui fonctionne avec le fichier pour lequel il a été créé mais pas avec mon fichier. La différence entre les deux fichiers est que les miens sont tous identiques (=la plage a copier/coller est toujours la même).
J'ai tenté de l'adapter mais comme tu as pu le remarquer je sais pas coder :)



Code: 
Sub conso_files()

    Dim f As FileDialog
    Dim chemins As Variant, path As Variant, tableau As Variant, selectedFiles As Variant
    Dim wb As Workbook, sh As Worksheet
    Dim i As Integer, files_last_col As Integer
    Dim files_last_row As Long, db_last_row As Long
    Dim check As Boolean
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With DB
    
        'on demande à l'utilisateur s'il souhaite réinitialiser la base
        If .Cells(1, 1).Value <> "" Then
            If MsgBox("Cette action va réinitialiser la base de données. Êtes-vous sûr(e) de vouloir continuer ?", vbYesNo + vbInformation) = vbNo Then GoTo fin
        End If
            
        'on clear DB
        .Cells.ClearContents
        .Range(.Cells(db_row_titles + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
    
    End With

    'userform pour choisir le dossier
    Set f = Application.FileDialog(msoFileDialogFilePicker)
    
    With f
        
        .Filters.Clear
        .Filters.Add "Classeur Excel", "*.xls; *.xlsx; *.xlsm", 1
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.path
        
        If .Show = -1 Then
            j = 1
            ReDim tableau(1 To .SelectedItems.Count, 1 To 1)
            For Each selectedFiles In .SelectedItems
                tableau(j, 1) = selectedFiles
                j = j + 1
            Next
        End If
        
    End With
    
    If IsEmpty(tableau) Then GoTo fin
    If Not Cancelled Then chemins = tableau
    
    'boucle sur les fichiers à consolider
    For Each path In chemins
               
        'on ouvre le fichier à consolider
        Application.StatusBar = "Importing " & Dir(path) & "..."
        Set wb = Application.Workbooks.Open(path, , True)
        DoEvents
    
        'boucle sur les onglets
        For Each sh In wb.Sheets
        
            With sh
        
                'si couleur d'onglet <> rouge ou range pays vide on sort de la boucle
                If .Tab.Color <> 255 Or .Range("J3").Value = "" Then GoTo next_sheet

                'on déprotège la feuille
                sh.Unprotect pw

                'on défiltre/démasque tout
                .AutoFilterMode = False
                .Range("A1").ClearOutline
                .Cells.UnMerge
                            
                'on récupère la dernière ligne et colonne
                files_last_row = .Cells(.Rows.Count, 1).End(xlUp).Row
                files_last_col = .Cells(files_row_titles - 1, 1000).End(xlToLeft).Column
                
                'si la conso est vide on récupère les titres et la ligne de flags
                If check = False Then
                    .Rows(1).Copy
                    DB.Cells(1, 1).PasteSpecial xlValues
                    .Rows(files_row_titles - 2 & ":" & files_row_titles).Copy
                    DB.Rows(db_row_titles - 2 & ":" & db_row_titles).PasteSpecial xlValues
                    check = True
                End If
                
                'on filtre sur le code produit
                .Range(.Cells(files_row_titles, 1), .Cells(files_last_row, files_last_col)).AutoFilter Field:=files_col_code, Criteria1:="<>"
                            
                'on copie-colle les données dans DB
                db_last_row = DB.Cells(DB.Rows.Count, 1).End(xlUp).Row
                .Range(.Cells(files_row_titles + 1, 1), .Cells(files_last_row, files_last_col)).Copy
                DB.Cells(db_last_row + 1, 1).PasteSpecial xlValues
            
            End With
        
next_sheet:
        Next
        
        'on ferme le fichier
        Application.CutCopyMode = False
        wb.Close False
        DoEvents

    Next

    'on supprime les colonnes inutiles
    For i = files_last_col To 1 Step -1
        If DB.Cells(1, i).Value = "" Then DB.Columns(i).Delete
    Next
    
    
    MsgBox "Consolidation terminée !", vbInformation

fin:
    With Application
        .CutCopyMode = False
        .StatusBar = False
        .Goto DB.Cells(1, 1), scroll:=True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub

Sub sdfds()

Application.StatusBar = False
End Sub
 
C

cachou91

Nouveau membre


Pour moi db c'est ma base de données, donc la feuille vierge dans laquelle je copie/colle les données
 
drul

drul

Obscur pro du hardware
Staff
Oui mais là dans ton code "DB", c'est juste une variable vide, à moins qu'ailleurs dans le code elle ne soit initialisée ...
Soit tu n'as pas donnée tout le code, soit ça ne peut juste pas marcher ...
 
C

cachou91

Nouveau membre


Cette macro (pas de fichier stp) a été faite pour ce fichier :

Sur le même principe je voudrais l'adapter à ce fichier : Titre: ligne 1 et la plage A11:AE492

Si je selectionne mon fichier avec la macro ca ne fonctionne pas mais ca fonctionne bien avec le 1er fichier

Edit modération: dsl, je peux pas laisser des liens sur des fichiers contenant un code potentiellement malveillant, c'est contraire à la charte du forum. seul du texte et des images sont acceptés.


 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 125
Messages
6 717 736
Membres
1 586 357
Dernier membre
Peg7
Partager cette page
Haut