Faire une compilation de tableau

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion auverland
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

auverland

XLDnaute Occasionnel
Bonjour a tous

Je souhaite faire un récap de différents tableau/fichier et le top qu'il parcourt l'intégralité des sous répertoir par rapport à son emplacement

Ci joint le fichier type "récap Méto site" que j'aimerais obtenir

Chaque fichier de donnés "Méto site XXX" sont iddentique en onglet et format d'onglet
_ grossierement supression des deux premieres ligne du fichier
_ récupereation du tableau résultat
_ récupération des cellule #ref! de chaque paragraphe ex "B7" sur cuillière

Pour tout coller les uns a coté des autres sur récap en indiquant le nom du fichier en haut de chaque résultat

Merci pour votre aide
Auverland
 

Pièces jointes

Trier par date Trier par votes
Re : Faire une compilation de tableau

Bonsoir Auverland, bonsoir le forum,

Le code à placer dans le classeur recap Méto site.xls :
Code: 
Sub Macro1()
Dim cd As Workbook 'déclare la variable cd (Classeur Destination)
Dim od1 As Object 'déclare la variable od1 (Onglet Destination 1)
Dim od2 As Object 'déclare la variable od2 (Onglet Destination 2)
Dim od3 As Object 'déclare la variable od3 (Onglet Destination 3)
Dim ch As String 'déclare la variable ch (CHemin)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d (Dossier)
Dim o As Object 'déclare la variable o (Onglets)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os1 As Object 'déclare la variable os (Onglet Source 1)
Dim os2 As Object 'déclare la variable os (Onglet Source 2)
Dim os3 As Object 'déclare la variable os (Onglet Source 3)
Dim dest1 As Range 'déclare la variable dest1 (cellule de DESTination 1)
Dim dest2 As Range 'déclare la variable dest2 (cellule de DESTination 2)
Dim dest3 As Range 'déclare la variable dest3 (cellule de DESTination 3)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set cd = ThisWorkbook 'définit le classeur destination cd
ch = cd.Path 'définit la chemin
Set od1 = cd.Sheets("Récap cuilliere") 'définit l'onglet de destination od1
Set od2 = cd.Sheets("Récap couteau") 'définit l'onglet de destination od2
Set od3 = cd.Sheets("Récap Fourchettes") 'définit l'onglet de destination od3
'suppression des anciennes données
od1.Range("E1:" & od1.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
od2.Range("E1:" & od2.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
od3.Range("E1:" & od3.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
Set sf = CreateObject("Scripting.FileSystemObject") 'définit la variable sf
Set d = sf.getfolder(ch) 'définit la variable d
Set fs = d.Files 'définit la variable fs
For Each f In fs 'boucles sur touts les fichiers du dossier d
    'condition : si le fichier f à une extension ".xls" et commence par "Méto site"
    If Right(f.Name, 4) = ".xls" And Left(f.Name, 9) = "Méto site" Then
        'définit dest1 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 5 colonnes à droite)
        Set dest1 = IIf(od1.Range("E3").Value = "", od1.Range("E3"), od1.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 5))
        'définit dest2 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 3 colonnes à droite)
        Set dest2 = IIf(od2.Range("E3").Value = "", od2.Range("E3"), od2.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 3))
        'définit dest3 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 5 colonnes à droite)
        Set dest3 = IIf(od3.Range("E3").Value = "", od3.Range("E3"), od3.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 5))
        Workbooks.Open f 'ouvre le fichier
        Set cs = ActiveWorkbook 'définit le classeur source cs
        Set os1 = cs.Sheets("cuilliere") 'définit l'onglet source os1
        Set os2 = cs.Sheets("couteau") 'définit l'onglet source os2
        Set os3 = cs.Sheets("Fourchettes") 'définit l'onglet source os3
        'récap cuillères
        dest1.Value = cs.Name 'place le nom du classeur
        os1.Range("E4:I32").Copy 'copie la plage utile plus une colonne
        dest1.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        os1.Range("E4:H32").Copy dest1.Offset(1, 0) 'copie/colle la plage utile
        dest1.Offset(4, 0).Value = os1.Range("B7").Value 'récupère le nom correspondant à Vita A
        dest1.Offset(13, 0).Value = os1.Range("B16").Value 'récupère le nom correspondant à Vita B
        dest1.Offset(23, 0).Value = os1.Range("B26").Value 'récupère le nom correspondant à Vita C
        'récap couteaux
        dest2.Value = cs.Name 'place le nom du classeur
        os2.Range("E4:G43").Copy 'copie la plage utile plus une colonne
        dest2.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        os2.Range("E4:F43").Copy dest2.Offset(1, 0) 'copie/colle la plage utile
        dest2.Offset(4, 0).Value = os2.Range("B7").Value 'récupère le nom correspondant à Vita A
        dest2.Offset(15, 0).Value = os2.Range("B18").Value 'récupère le nom correspondant à Vita b
        dest2.Offset(26, 0).Value = os2.Range("B29").Value 'récupère le nom correspondant à Vita A
        dest2.Offset(37, 0).Value = os2.Range("B40").Value 'récupère le nom correspondant à Inter MAR
        'récap fourchettes
        dest3.Value = cs.Name 'place le nom du classeur
        os3.Range("E4:I35").Copy 'copie la plage utile plus une colonne
        dest3.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        os3.Range("E4:H35").Copy dest3.Offset(1, 0) 'copie/colle la plage utile
        dest3.Offset(4, 0).Value = os3.Range("B7").Value 'récupère le nom correspondant à Vita b
        dest3.Offset(13, 0).Value = os3.Range("B16").Value 'récupère le nom correspondant à Vita b
        dest3.Offset(25, 0).Value = os3.Range("B28").Value 'récupère le nom correspondant à Vita b
        cs.Close 'ferme le classeur de données
    End If 'fin de la condition
Next f 'prochain classeur de la boucle
od3.Select: Range("A1").Select 'sélectionne la cellule A1
od2.Select: Range("A1").Select 'sélectionne la cellule A1
od1.Select: Range("A1").Select 'sélectionne la cellule A1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
Bien entendu, tous les fichiers doivent se trouver dans la même dossier que recap Méto site.xls...
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

C'est géniale, merci beaucoup pour votre gentillesse. Tout seul j'aurais vraiment abandonné l'idée

En plus avec tout les commentaires pour bien comprendre le cheminement.

Je vais maintenant essayer de le completer à mon besoin final.
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Bonjour,

J'ai souhaité intégrer une condition suplementaire pour un onglet dans le cas d'un format spécial
type :
Workbooks.Open f 'ouvre le fichier
Set cs = ActiveWorkbook 'définit le classeur source cs
Set os1 = cs.Sheets("cuilliere") 'définit l'onglet source os1
Set os2 = cs.Sheets("couteau") 'définit l'onglet source os2
Set os3 = cs.Sheets("Fourchettes") 'définit l'onglet source os3

If cs.Sheets("cuilliere").Range("B7").Value = "toto" Then
'récap cuillères
dest1.Value = cs.Name 'place le nom du classeur
os1.Range("f4:j32").Copy 'copie la plage utile plus une colonne
dest1.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
os1.Range("f4:i32").Copy dest1.Offset(1, 0) 'copie/colle la plage utile
dest1.Offset(4, 0).Value = os1.Range("B7").Value 'récupère le nom correspondant à Vita A
dest1.Offset(13, 0).Value = os1.Range("B16").Value 'récupère le nom correspondant à Vita B
dest1.Offset(23, 0).Value = os1.Range("B26").Value 'récupère le nom correspondant à Vita C
Else
'récap cuillères
dest1.Value = cs.Name 'place le nom du classeur
os1.Range("E4:I32").Copy 'copie la plage utile plus une colonne
dest1.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
..............
end if
je me retrouve avec l' Erreur d'execution 13 lors du traitement du deuxieme fichier

c'est quoi comme type d'erreur ?
Merci
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Bonjour Auverland, bonjour le forum,

Pas très clair... J'ai modifié le code en utilisant une variable plc. regarde si ça convient :
Code: 
Sub Macro1()
Dim cd As Workbook 'déclare la variable cd (Classeur Destination)
Dim od1 As Object 'déclare la variable od1 (Onglet Destination 1)
Dim od2 As Object 'déclare la variable od2 (Onglet Destination 2)
Dim od3 As Object 'déclare la variable od3 (Onglet Destination 3)
Dim ch As String 'déclare la variable ch (CHemin)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d (Dossier)
Dim o As Object 'déclare la variable o (Onglets)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os1 As Object 'déclare la variable os (Onglet Source 1)
Dim os2 As Object 'déclare la variable os (Onglet Source 2)
Dim os3 As Object 'déclare la variable os (Onglet Source 3)
Dim dest1 As Range 'déclare la variable dest1 (cellule de DESTination 1)
Dim dest2 As Range 'déclare la variable dest2 (cellule de DESTination 2)
Dim dest3 As Range 'déclare la variable dest3 (cellule de DESTination 3)
Dim plc As Range 'déclare la variable plc (PLage sous Condition)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set cd = ThisWorkbook 'définit le classeur destination cd
ch = cd.Path 'définit la chemin
Set od1 = cd.Sheets("Récap cuilliere") 'définit l'onglet de destination od1
Set od2 = cd.Sheets("Récap couteau") 'définit l'onglet de destination od2
Set od3 = cd.Sheets("Récap Fourchettes") 'définit l'onglet de destination od3
'suppression des anciennes données
od1.Range("E1:" & od1.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
od2.Range("E1:" & od2.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
od3.Range("E1:" & od3.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
Set sf = CreateObject("Scripting.FileSystemObject") 'définit la variable sf
Set d = sf.getfolder(ch) 'définit la variable d
Set fs = d.Files 'définit la variable fs
For Each f In fs 'boucles sur touts les fichiers du dossier d
    'condition : si le fichier f à une extension ".xls" et commence par "Méto site"
    If Right(f.Name, 4) = ".xls" And Left(f.Name, 9) = "Méto site" Then
        'définit dest1 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 5 colonnes à droite)
        Set dest1 = IIf(od1.Range("E3").Value = "", od1.Range("E3"), od1.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 5))
        'définit dest2 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 3 colonnes à droite)
        Set dest2 = IIf(od2.Range("E3").Value = "", od2.Range("E3"), od2.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 3))
        'définit dest3 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 5 colonnes à droite)
        Set dest3 = IIf(od3.Range("E3").Value = "", od3.Range("E3"), od3.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 5))
        Workbooks.Open f 'ouvre le fichier
        Set cs = ActiveWorkbook 'définit le classeur source cs
        Set os1 = cs.Sheets("cuilliere") 'définit l'onglet source os1
        Set os2 = cs.Sheets("couteau") 'définit l'onglet source os2
        Set os3 = cs.Sheets("Fourchettes") 'définit l'onglet source os3
        Set plc = IIf(os1.Range("B7").Value = "toto", os1.Range("F4:I32"), os1.Range("E4:H32")) 'définit la plage plc (à adapter car j'ai pas bien compris)
        'récap cuillères
        dest1.Value = cs.Name 'place le nom du classeur
        plc.Resize(plc.Rows.Count, plc.Columns.Count + 1).Copy 'copie la plage plc plus une colonne
        dest1.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        plc.Copy dest1.Offset(1, 0) 'copie/colle la plage plc
        dest1.Offset(4, 0).Value = os1.Range("B7").Value 'récupère le nom correspondant à Vita A
        dest1.Offset(13, 0).Value = os1.Range("B16").Value 'récupère le nom correspondant à Vita B
        dest1.Offset(23, 0).Value = os1.Range("B26").Value 'récupère le nom correspondant à Vita C
        'récap couteaux
        dest2.Value = cs.Name 'place le nom du classeur
        os2.Range("E4:G43").Copy 'copie la plage utile plus une colonne
        dest2.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        os2.Range("E4:F43").Copy dest2.Offset(1, 0) 'copie/colle la plage utile
        dest2.Offset(4, 0).Value = os2.Range("B7").Value 'récupère le nom correspondant à Vita A
        dest2.Offset(15, 0).Value = os2.Range("B18").Value 'récupère le nom correspondant à Vita b
        dest2.Offset(26, 0).Value = os2.Range("B29").Value 'récupère le nom correspondant à Vita A
        dest2.Offset(37, 0).Value = os2.Range("B40").Value 'récupère le nom correspondant à Inter MAR
        'récap fourchettes
        dest3.Value = cs.Name 'place le nom du classeur
        os3.Range("E4:I35").Copy 'copie la plage utile plus une colonne
        dest3.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        os3.Range("E4:H35").Copy dest3.Offset(1, 0) 'copie/colle la plage utile
        dest3.Offset(4, 0).Value = os3.Range("B7").Value 'récupère le nom correspondant à Vita b
        dest3.Offset(13, 0).Value = os3.Range("B16").Value 'récupère le nom correspondant à Vita b
        dest3.Offset(25, 0).Value = os3.Range("B28").Value 'récupère le nom correspondant à Vita b
        cs.Close 'ferme le classeur de données
    End If 'fin de la condition
Next f 'prochain classeur de la boucle
od3.Select: Range("A1").Select 'sélectionne la cellule A1
od2.Select: Range("A1").Select 'sélectionne la cellule A1
od1.Select: Range("A1").Select 'sélectionne la cellule A1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Bonjour,
Il met le même code "ereur execution13 incompatibilité de type" au traitement du deuxieme fichier juste après les lignes : (execution pas à pas )

Set os1 = cs.Sheets("cuilliere") 'définit l'onglet source os1
Set os2 = cs.Sheets("couteau") 'définit l'onglet source os2
Set os3 = cs.Sheets("Fourchettes") 'définit l'onglet source os3
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Bonjour Auverland, bonjour le forum,

Ce numéro d'erreur indique que l'indice n'appartient pas à la sélection. Vérifie le nom des onglets du second fichiers. Il faut qu'il soit exactement identique à couteau. Pas un espace en plus au début ou à la fin, pas un x à la fin.
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Robert à dit:
Bonjour Auverland, bonjour le forum,

Ce numéro d'erreur indique que l'indice n'appartient pas à la sélection. Vérifie le nom des onglets du second fichiers. Il faut qu'il soit exactement identique à couteau. Pas un espace en plus au début ou à la fin, pas un x à la fin.
Cliquez pour agrandir...

c'est justement ce que je comprend pas, j'utilise exactement mêmes fichiers...
La premiere macro que tu as concocté est collé dans mon fichier "recap Méto site.xls" en macro1 ca fonctionne nikel
La deuxieme je la colle aussi dans ce même fichier en macro2 et la ça beug !!!

Incompatibilité de type
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Bonjour a tous,

Deux nouveau petit soucis, je cherche juste les 2 commandes qui permettent de :

- controle la presence de l'onglet

- Je cherche la même fonction avec contient ("cuilliere") et non est ("cuilliere") pour la ligne :
Set os1 = cs.Sheets("cuilliere") 'définit l'onglet source os1

Merci et bone semaine
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Bonjour Auverland, bonjour le forum,

Peut-être comme ça :
Code: 
Dim os1 As Object
Dim sh As Object

On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set os1 = Sheets("cuilliere") 'définit l'onglet o (génère une erreur si l'onglet "test" n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err = 0 'annule l'erreur
    For Each sh In Sheets 'boucle   sur tous les onglets du classeur
        If sh.Name Like "*cuilliere*" Then 'condition : si le nom de l'onglet contient "cuilliere"
            Set os1 = sh 'définit l'onglet os1
            Exit For 'sort de la boucle
        End If 'fin de la condition
    Next sh 'prochain onglet de la boucle
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Merci Robert ca marche bien
par contre ca ne gère pas un onglet absent
j'ai trouvé la macro pour mais j'arrive pas à mixer les deux

Sub Absence_Onglet()
On Error Resume Next
Err = 0
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = "Nom de l'onglet à créer"
If Err <> 0 Then
application.displayalerts=false
activesheet.delete 'détruit la feuille créée
application.displayalerts=true
End If
End Sub


Dim os1 As Object
Dim sh As Object

On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set os1 = Sheets("cuilliere") 'définit l'onglet o (génère une erreur si l'onglet "test" n'existe pas)
Set os2 = Sheets("couteau") 'définit l'onglet o (génère une erreur si l'onglet "test" n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err = 0 'annule l'erreur
For Each sh In Sheets 'boucle sur tous les onglets du classeur
If sh.Name Like "*cuilliere*" Then 'condition : si le nom de l'onglet contient "cuilliere"
Set os1 = sh 'définit l'onglet os1
Exit For 'sort de la boucle
Else
If sh.Name Like "*cuilliere*" Then 'condition : si le nom de l'onglet contient "cuilliere"
Set os1 = sh 'définit l'onglet os1
Exit For 'sort de la boucle
End If 'fin de la condition
Next sh 'prochain onglet de la boucle
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs.

Merci pour votre aide
 
Vote positif 0 Vote négatif
Re : Faire une compilation de tableau

Bonsoir Auverland, bonsoir le forum,

J'ai pas bien compris où tu veux en venir. Essaie d'être un petit plus explicite...
Le code ci-dessous recherche si le classeur possède un onglet dont le nom contient "cuilliere". S'il n'en trouve pas, il crée un nouvel onglet et le nomme "cuilliere" (voir la partie entre les lignes 46 à 63).

Code: 
Sub Macro1()
Dim cd As Workbook 'déclare la variable cd (Classeur Destination)
Dim od1 As Object 'déclare la variable od1 (Onglet Destination 1)
Dim od2 As Object 'déclare la variable od2 (Onglet Destination 2)
Dim od3 As Object 'déclare la variable od3 (Onglet Destination 3)
Dim ch As String 'déclare la variable ch (CHemin)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d (Dossier)
Dim o As Object 'déclare la variable o (Onglets)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os1 As Object 'déclare la variable os (Onglet Source 1)
Dim os2 As Object 'déclare la variable os (Onglet Source 2)
Dim os3 As Object 'déclare la variable os (Onglet Source 3)
Dim dest1 As Range 'déclare la variable dest1 (cellule de DESTination 1)
Dim dest2 As Range 'déclare la variable dest2 (cellule de DESTination 2)
Dim dest3 As Range 'déclare la variable dest3 (cellule de DESTination 3)
Dim plc As Range 'déclare la variable plc (PLage sous Condition)
Dim test As Boolean 'décalre la variable test

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set cd = ThisWorkbook 'définit le classeur destination cd
ch = cd.Path 'définit la chemin
Set od1 = cd.Sheets("Récap cuilliere") 'définit l'onglet de destination od1
Set od2 = cd.Sheets("Récap couteau") 'définit l'onglet de destination od2
Set od3 = cd.Sheets("Récap Fourchettes") 'définit l'onglet de destination od3
'suppression des anciennes données
od1.Range("E1:" & od1.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
od2.Range("E1:" & od2.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
od3.Range("E1:" & od3.Cells(5, Application.Columns.Count).Address(0, 0)).EntireColumn.Delete 'supprime les colonnes E à... dernière
Set sf = CreateObject("Scripting.FileSystemObject") 'définit la variable sf
Set d = sf.getfolder(ch) 'définit la variable d
Set fs = d.Files 'définit la variable fs
For Each f In fs 'boucles sur touts les fichiers du dossier d
    'condition : si le fichier f à une extension ".xls" et commence par "Méto site"
    If Right(f.Name, 4) = ".xls" And Left(f.Name, 9) = "Méto site" Then
        'définit dest1 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 5 colonnes à droite)
        Set dest1 = IIf(od1.Range("E3").Value = "", od1.Range("E3"), od1.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 5))
        'définit dest2 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 3 colonnes à droite)
        Set dest2 = IIf(od2.Range("E3").Value = "", od2.Range("E3"), od2.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 3))
        'définit dest3 (E3 si E3 est vide, sinon la première colonne vide de la ligne 3 décalée de 5 colonnes à droite)
        Set dest3 = IIf(od3.Range("E3").Value = "", od3.Range("E3"), od3.Cells(3, Application.Columns.Count).End(xlToLeft).Offset(0, 5))
        Workbooks.Open f 'ouvre le fichier
        Set cs = ActiveWorkbook 'définit le classeur source cs
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        Set os1 = Sheets("cuilliere") 'définit l'onglet o (génère une erreur si l'onglet "test" n'existe pas)
        If Err <> 0 Then 'condition : si une erreur a été générée
            Err = 0 'annule l'erreur
            For Each sh In Sheets 'boucle   sur tous les onglets du classeur
                If sh.Name Like "*cuilliere*" Then 'condition : si le nom de l'onglet contient "cuilliere"
                    Set os1 = sh 'définit l'onglet os1
                    test = True
                    Exit For 'sort de la boucle
                 End If
            Next sh 'prochain onglet de la boucle
            If test = False Then
                ActiveWorkbook.Sheets.Add
                ActiveSheet.Name = "Cuilliere"
                Set os1 = ActiveSheet
            End If 'fin de la condition
        End If 'fin de la condition
        On Error GoTo 0 'annule la gestion des erreurs
        Set os2 = cs.Sheets("couteau") 'définit l'onglet source os2
        Set os3 = cs.Sheets("Fourchettes") 'définit l'onglet source os3
        Set plc = IIf(os1.Range("B7").Value = "toto", os1.Range("F4:I32"), os1.Range("E4:H32")) 'définit la plage plc (à adapter car j'ai pas bien compris)
        'récap cuillères
        dest1.Value = cs.Name 'place le nom du classeur
        plc.Resize(plc.Rows.Count, plc.Columns.Count + 1).Copy 'copie la plage plc plus une colonne
        dest1.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        plc.Copy dest1.Offset(1, 0) 'copie/colle la plage plc
        dest1.Offset(4, 0).Value = os1.Range("B7").Value 'récupère le nom correspondant à Vita A
        dest1.Offset(13, 0).Value = os1.Range("B16").Value 'récupère le nom correspondant à Vita B
        dest1.Offset(23, 0).Value = os1.Range("B26").Value 'récupère le nom correspondant à Vita C
        'récap couteaux
        dest2.Value = cs.Name 'place le nom du classeur
        os2.Range("E4:G43").Copy 'copie la plage utile plus une colonne
        dest2.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        os2.Range("E4:F43").Copy dest2.Offset(1, 0) 'copie/colle la plage utile
        dest2.Offset(4, 0).Value = os2.Range("B7").Value 'récupère le nom correspondant à Vita A
        dest2.Offset(15, 0).Value = os2.Range("B18").Value 'récupère le nom correspondant à Vita b
        dest2.Offset(26, 0).Value = os2.Range("B29").Value 'récupère le nom correspondant à Vita A
        dest2.Offset(37, 0).Value = os2.Range("B40").Value 'récupère le nom correspondant à Inter MAR
        'récap fourchettes
        dest3.Value = cs.Name 'place le nom du classeur
        os3.Range("E4:I35").Copy 'copie la plage utile plus une colonne
        dest3.Offset(1, 0).PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
        os3.Range("E4:H35").Copy dest3.Offset(1, 0) 'copie/colle la plage utile
        dest3.Offset(4, 0).Value = os3.Range("B7").Value 'récupère le nom correspondant à Vita b
        dest3.Offset(13, 0).Value = os3.Range("B16").Value 'récupère le nom correspondant à Vita b
        dest3.Offset(25, 0).Value = os3.Range("B28").Value 'récupère le nom correspondant à Vita b
        cs.Close 'ferme le classeur de données
    End If 'fin de la condition
Next f 'prochain classeur de la boucle
od3.Select: Range("A1").Select 'sélectionne la cellule A1
od2.Select: Range("A1").Select 'sélectionne la cellule A1
od1.Select: Range("A1").Select 'sélectionne la cellule A1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

B
  • Question Question
XL 2019 Rapatrier des données de plusieurs feuilles (nombre évolutif) dans un seul tableau récapitulatif
Réponses
3
Affichages
700
job75
job75
My<3
  • Question Question
XL 2016 Information de cellule contiguë a déplacer dans une compilation
Réponses
3
Affichages
668
job75
job75
J
  • Question Question
Microsoft 365 Récupération de lignes de plusieurs feuille sur une seule en fonction d'une valeur de cellule
Réponses
6
Affichages
2 K
jireu
J
N
  • Question Question
Microsoft 365 Macro (ou autre astuce) pour créer un tableau de bord à partir d'un tableau de données
Réponses
0
Affichages
1 K
nicolasraque
N
L
  • Question Question
XL 2016 problème sur mon tableau de Statistiques
Réponses
1
Affichages
921
laurent54000
L
B
  • Question Question
Problématique tableau de bord
Réponses
6
Affichages
1 K
Bizon91
B
R
  • Question Question
Récupération des données de plusieurs fichiers dans un seul
2
Réponses
22
Affichages
13 K
Robert
Robert
XairteX
  • Question Question
Données numériques variables comme critère de recherche de dans une matrice
Réponses
2
Affichages
839
XairteX
XairteX
Z
  • Question Question
Macro d'envoi automatique d'éléments dans un tableau de synthèse
Réponses
0
Affichages
769
Zoub
Z
E
  • Question Question
Faire apparaître une valeur dans une cellule en fonction de plusieurs critères
Réponses
0
Affichages
1 K
elodu22
E
G
  • Question Question
Recherche conseils avises pour finaliser la realisation d'un tableau de bord
3 4 5
Réponses
70
Affichages
82 K
Bebere
B
M
  • Question Question
Calcul de moyennes et copie des resultats dans un tableau recapitulatif
Réponses
4
Affichages
1 K
mlt38
M
Y
  • Question Question
rechercheV avec une boucle sur le numéro de colonne
Réponses
2
Affichages
1 K
yannick63430
Y
M
  • Question Question
Comment faire une compilation de résultats à partir de classeurs différents
Réponses
1
Affichages
5 K
CHALET53
C
R
  • Question Question
Faire une recherche de valeur dans un calendrier pour reporter dans tableau "today"
Réponses
13
Affichages
2 K
rico83600
R
E
  • Question Question
Faire une recherche de plusieurs valeurs avec saut de cellule
Réponses
11
Affichages
2 K
Eole
E
D
  • Question Question
Regrouper des lignes de plusieurs fichiers dans un seul tableau avec une macro
Réponses
5
Affichages
4 K
davids petrucci
D
A
  • Question Question
Exporter une partie de résultat d'un TDC
2
Réponses
20
Affichages
3 K
JCGL
JCGL
M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
35 K
MichelXld
M
Retour