Macro de consolidation

[Gengiskhan]

Bonjour le forum,
mon problème est le suivant, je cherche a adapter une macro que j'ai récupéré sur ce même forum. celle-ci en fait :

Option Explicit

Const sSheetList  As String = "Conso BP"

Sub ConcatenateTables()
    Dim vCurfile    As Variant
    Dim oCurWbk     As Workbook
    Dim oFD         As FileDialog
    Dim ws As Worksheet
    Dim alexp As String
    
    alexp = "Nom Onglet"

    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    
    oFD.AllowMultiSelect = True 'autoriser la sélection de plusieurs fichier
    oFD.Filters.Clear 'RAZ des filtres de fichiers
    oFD.Filters.Add Description:="Excel Files", Extensions:="*.xls;*.xlsx" 'filtrer sur les fichiers excel
    oFD.Show 'afficher la boite de dialogue
    
    If oFD.SelectedItems.Count > 0 Then
        ThisWorkbook.Sheets(sSheetList).Range("A2").Select 'efface a partir de A2
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents

        For Each vCurfile In oFD.SelectedItems 'pour chaque fichier séléctionné
            Application.DisplayAlerts = False
            Set oCurWbk = Application.Workbooks.Open(Filename:=vCurfile) 'ouvrir le classeur
            For Each ws In Worksheets 'Test sur le nom de tous les onglets
            If InStr(1, ws.Name, alexp) <> 0 Then ' Selection des onglets qui contiennent la bonne chaine de caractere
            ws.Activate
            Range("a97:cm151").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
            ThisWorkbook.Activate
            ThisWorkbook.Sheets(sSheetList).Range("A65536").End(xlUp).Offset(1).Select
            ThisWorkbook.Sheets(sSheetList).Paste
            Application.CutCopyMode = False
            
            End If
            Next

            oCurWbk.Close savechanges:=False 'fermer le classeur sans sauvegarder
        Next vCurfile
    End If
End Sub '~ConcatenateTables

en l'occurrence elle me permet de récupérer et consolider dans une seule feuille, la plage définit dans chaque fichier sélectionnés.
Je souhaite l'adapter en lui spécifiant non pas une chaine de caractère à "matcher" mais une liste de Nom d'onglets bien précis (peut-être à déclarer en autant de variables), a tester dans chaque classeur sélectionnés.

ex :
- si tu trouves dans classeur 1 soit "onglet1" soit "onglet 2" soit etc... alors sélectionner et copier.
- si tu trouve dans classeur 2 soit "onglet1" soit "onglet 2" soit etc... alors sélectionner et copier.
et ainsi de suite...


je ne sais pas si je suis assez clair ?

merci d'avance.

 

[Guest]

Re : Macro de consolidation

bonjour,

Normalement, en reseignant la variable alexp comme suit:

alexp = "Onglet1;Onglet2; Onglet4"

Cela devrait le faire

Par contre si tu as:

alexp = "Onglet11;Onglet2; Onglet4"

Onglet1 sera trouvé (dans Onglet11)

alors il faudra procéder autrement. Tout dépend de tes nom réels d'onglets.

Solution 2 (plus sûre):

Dim alexp
alexp = Array("Nom Onglet", "Onglet2", "Onglet3")

Puis remplacer la ligne

If InStr(1, ws.Name, alexp) <> 0 Then

Par

If Not IsError(Application.Match(ws.Name, alexp, 0)) Then

Et tant qu' à faire, réécriture de la procédure

[COLOR=BLUE]Sub[/COLOR] ConcatenateTables()
    [COLOR=BLUE]Dim[/COLOR] vCurfile [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Variant[/COLOR]
    [COLOR=BLUE]Dim[/COLOR] oCurWbk [COLOR=BLUE]As[/COLOR] Workbook
    [COLOR=BLUE]Dim[/COLOR] oFD [COLOR=BLUE]As[/COLOR] FileDialog
    [COLOR=BLUE]Dim[/COLOR] ws [COLOR=BLUE]As[/COLOR] Worksheet, wsList [COLOR=BLUE]As[/COLOR] Worksheet
    [COLOR=BLUE]Dim[/COLOR] alexp
    [COLOR=BLUE]Dim[/COLOR] xCol [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Long[/COLOR], xLig [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Long[/COLOR]
    
    [COLOR=GREEN]'Nombre de lignes et colonnes de la plage à copier[/COLOR]
    xLig = Range([i]"a97:cm151"[/i]).Rows.Count
    xCol = Range([i]"a97:cm151"[/i]).Columns.Count
    
    [COLOR=GREEN]'Liste des onglets[/COLOR]
    alexp = Array([i]"Nom Onglet"[/i], [i]"Onglet2"[/i], [i]"Onglet3"[/i])
    [COLOR=BLUE]Set[/COLOR] oFD = Application.FileDialog(msoFileDialogFilePicker)
    oFD.AllowMultiSelect = [COLOR=BLUE]True[/COLOR]    [COLOR=GREEN]'autoriser la sélection de plusieurs fichier[/COLOR]
    oFD.Filters.Clear    [COLOR=GREEN]'RAZ des filtres de fichiers[/COLOR]
    oFD.Filters.Add Description:=[i]"Excel Files"[/i], Extensions:=[i]"*.xls;*.xlsx"[/i]    [COLOR=GREEN]'filtrer sur les fichiers excel[/COLOR]
    oFD.Show    [COLOR=GREEN]'afficher la boite de dialogue[/COLOR]
    [COLOR=BLUE]If[/COLOR] oFD.SelectedItems.Count > 0 [COLOR=BLUE]Then[/COLOR]
        [COLOR=BLUE]Set[/COLOR] wsList = ThisWorkbook.Sheets(sSheetList)    [COLOR=GREEN]'efface a partir de A2[/COLOR]
        [COLOR=BLUE]With[/COLOR] wsList.Range([i]"A2"[/i]).CurrentRegion
            .Offset(1).Resize(.Rows.Count - 1).ClearContents
        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]With[/COLOR]
        [COLOR=BLUE]For[/COLOR] [COLOR=BLUE]Each[/COLOR] vCurfile [COLOR=BLUE]In[/COLOR] oFD.SelectedItems    [COLOR=GREEN]'pour chaque fichier séléctionné[/COLOR]
            Application.DisplayAlerts = [COLOR=BLUE]False[/COLOR]
            [COLOR=BLUE]Set[/COLOR] oCurWbk = Application.Workbooks.[COLOR=BLUE]Open[/COLOR](Filename:=vCurfile)    [COLOR=GREEN]'ouvrir le classeur[/COLOR]
            [COLOR=BLUE]For[/COLOR] [COLOR=BLUE]Each[/COLOR] ws [COLOR=BLUE]In[/COLOR] Worksheets    [COLOR=GREEN]'Test sur le nom de tous les onglets[/COLOR]
                [COLOR=BLUE]If[/COLOR] [COLOR=BLUE]Not[/COLOR] IsError(Application.Match(ws.Name, alexp, 0)) [COLOR=BLUE]Then[/COLOR]
                    [COLOR=GREEN]'Copie des valeurs de ws.Range([i]"a97:cm151"[/i]) dans wsList[/COLOR]
                    wsList.Range([i]"A65536"[/i]).[COLOR=BLUE]End[/COLOR](xlUp).Offset(1).Resize(xLig, xCol).Value = ws.Range([i]"a97:cm151"[/i]).Value
                [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
            [COLOR=BLUE]Next[/COLOR]
            oCurWbk.[COLOR=BLUE]Close[/COLOR] savechanges:=[COLOR=BLUE]False[/COLOR]    [COLOR=GREEN]'fermer le classeur sans sauvegarder[/COLOR]
        [COLOR=BLUE]Next[/COLOR] vCurfile
    [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]    [COLOR=GREEN]'~ConcatenateTablesen l'occurrence elle [COLOR=BLUE]me[/COLOR] permet de récupérer et[/COLOR]

A+

 

[Gengiskhan]

Re : Macro de consolidation

merci bcp,
alors j'ai testé avec ton dernier code, ça marche pô
par contre en intégrant dans mon ancien code ta première proposition

alexp = Array("nom onglet")

et

If Not IsError(Application.Match(ws.Name, alexp, 0))

ça marche nikel , sauf qu'a priori la fonction Array n'admet qu'un nombre restreint d'expression, dans la mesure où je dois lui référencer plus 80 onglets ça lui a poser problème.

étant donné que je suis tout sauf calé en macro, j'ai "bidouillé à l'arrache" et redéfinit une autre variable pour diviser en deux le nombre d'expression dans la fonction Array().

le principale c'est que ça marche et je t'en remercie.
a+