Discussion :

[FCL31]

Voila j'ai un code qui me permet de regrouper plusieurs fichiers Excel :
J'ouvre le fichier, un UserForm s'ouvre et me demande de chercher un chemin d'accés d'un dossier dans lequel sont present plusieurs fichier Excel
Lorsque le chemin est spécifier, je fais "Ok" et tout les fichier et chacune des feuilles de chaque classeurs sont regroupées sur une même feuille.

Voici le code que j'ai :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Workbook_Open()
     Recherche.Show
 End Sub

Le UserForm :
-La TextBox affiche le chemin d'accés choisi
-CommandButton1 permet d'afficher une fenêtre pour chercher le dossier dans lequel sont les fichiers Excel
-CommandButton2 permet de valider le chemin d'accés choisi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
    ByVal lpString2 As String) As Long
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
     ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
Private Sub CommandButton1_Click()
    Dim lpIDList As Long
    Dim strBuffer As String
    Dim strTitre As String
    Dim tBrowseInfo As BrowseInfo
    Dim SelectFolder As String
    Dim Handle As Long
 
strTitre = Titre
With tBrowseInfo
    .hWndOwner = Handle
    .lpszTitle = lstrcat(strTitre, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
    strBuffer = String(260, vbNullChar)
    SHGetPathFromIDList lpIDList, strBuffer
    SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End If
    Recherche.TextBox1.Text = SelectFolder & "\"
End Sub
Private Sub CommandButton2_Click()
    Appel
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public msg As String
 Sub Appel() 'A ADAPTER
Dim Chemin As String
    Application.ScreenUpdating = False
        Chemin = Recherche.TextBox1.Text
        Ouvrir Chemin
            Application.ScreenUpdating = True
    If msg <> "" Then _
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub
Sub Ouvrir(Chemin As String)
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
    Application.DisplayAlerts = False 'Evite les messages d'Excel
    'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
    Application.EnableEvents = False
        NomFich = Dir(Chemin & "*.xls")
        If NomFich = "" Then
             MsgBox "Aucun fichier trouvé dans " & Chemin
             Exit Sub
        End If
        Do While NomFich <> ""
            Set CL2 = Workbooks.Open(Chemin & NomFich)
            DoEvents
            Copie CL2
            CL2.Close False
            DoEvents
            ThisWorkbook.Save 'enregistrement du classeur après chaque copie
            DoEvents
            NomFich = Dir
        Loop
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub
Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, FL1 As Worksheet, derlig As Long
    Set FL1 = ThisWorkbook.Worksheets("feuil1") 'feuille où les données sont collées
    For Each LaFeuille In CL2.Worksheets 'parcours du classeur à copier
        'On vérifie que la feuille n'est pas vide
        If Not (LaFeuille.UsedRange.Address = "$A$1" And Range("A1") = "") Then
            derlig = FL1.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide
            On Error Resume Next
            LaFeuille.UsedRange.Copy FL1.Cells(derlig, 1)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
            End If
        End If
    Next
End Sub

Tout marche bien mais je voudrais l'adapter pou une autre utilisation:
Simplement j'ai plusieurs fichiers dans un même dossier et je voudrai que les fichiers soit mis sur une feuille différent dans le classeur au lieu de tout mettre sur la même feuille :

Au départ j'ai le fichier A et le fichier B
Je voudrai un fichier C avec une feuille A et une feuille B

J'espère avoir été assai clair

Merci d'avance

[aalex_38]

Bonjour,

Ici tu détermine FL1 ou sont copiees les donnees

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set FL1 = ThisWorkbook.Worksheets("feuil1")

Pour chaque feuille de ton classeur tu peux faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set FL1 = ThisWorkbook.Worksheets.add(after:=Worksheets.count)

Mais cette solution me semble un peu "tirée par les cheveux", pourquoi pas à chaque ouverture de classeur recopier la feuille entière dans le classeur maitre ?

Pour le code utilises l'enregistreur de macro, pendant que tu copies une feuille vers ton classeur et adaptes le résultat.

A+

[FCL31]

Le truc c'est que pour moi il y a pas de problème.

Ce sont les utilisateurs qui ne connaissent rien a Excel et il faut pas trop leurs en demander.

Ils leurs faut pouvoir le faire en quelques clic sinon dans trois ans on y est encore : le temps de leurs expliquer, de leurs montrer 10 fois avant qu'ils te dissent qu'il ont compris sans avoir compris

Donc il me semble que le faire pas simple macros simplifierait beaucoup les chose (juste des boutons à leurs montrer)

[aalex_38]

Ce que je te propose n'a rien de complexe, il s'agit de reciopier la feuille entière dans ton classeur, par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each LaFeuille In CL2.Worksheets 
 LaFeuille.Copy After:=ThisWorkbook.workSheets(thisworkbook.worksheets.count)
Next Lafeuille

[FCL31]

Excuse moi mais je vois pas où je doit mettre ce code

Moi je voudrais ouvrir un fichier dans lequel il n'y pas de données mais dans lequel il y a les macro.

Il suffit de faire 2 - 3 clics et puis c'est bon

[aalex_38]

Ce que je te proposais, c'est dans ta boucle pour ouvrir, au lieu de recopier en fin de feuille, de recopier la feuille dans le nouveau classeur, c'est ça que tu voulais non ?

[FCL31]

C'est cool, sa a l'air de marché

Voici commencent je fait fonctionner la macro :

Dans un classeur (Test), je lance la macro qui me permet dans un premier temps de choisir où sont le fichiers a regrouper (Classeur1 avec les données dans Feuil1 et Classeur2 avec les données dans Feuil1 )

Seul truc qui ne me va pas :

lorsque je lance la macro, sa me fait :

Le classeur Test avec les trois feuille du classeur + les trois feuilles de chaqu'un des autres classeurs.

Donc au final sa me fait le classeur Test avec (voir pièce jointe)



Y a t'il une solution pour ne pas avoir (dans se cas present) les 6 feuilles mais seulement 2 (une par classeur recherché)

[Krovax]

une solution
avant d'importer tu compte le nombre d'onglet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nbini=sheets.count

Tu importe uniquement l'onglet qui t'intéresse
(la ca dépend de ton code)

Et ensuite tu supprime les onglet initiaux (en partant du principe que tu importe les onglets a la suite comme le semble indiqué ton image)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
for i=nbini to 1 step -1
sheets(i).delete
next i

[FCL31]

Voici ce que j'ai modifié avec l'aide de aalex_38 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, FL1 As Worksheet, derlig As Long
    Set FL1 = ThisWorkbook.Worksheets("feuil1") 'feuille où les données sont collées
 
 
'    For Each LaFeuille In CL2.Worksheets 'parcours du classeur à copier
        'On vérifie que la feuille n'est pas vide
 
 
For Each LaFeuille In CL2.Worksheets
 LaFeuille.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
 
 
'Next LaFeuille
 
 
If Not (LaFeuille.UsedRange.Address = "$A$1" And Range("A1") = "") Then
            derlig = FL1.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide
            On Error Resume Next
            LaFeuille.UsedRange.Copy FL1.Cells(derlig, 1)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
            End If
        End If
    Next LaFeuille
End Sub

Avant sa me copier les classeurs sélectionner dans la première feuille sans en rajouter

une solution
avant d'importer tu compte le nombre d'onglet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nbini=sheets.count

Tu importe uniquement l'onglet qui t'intéresse
(la ca dépend de ton code)

Et ensuite tu supprime les onglet initiaux (en partant du principe que tu importe les onglets a la suite comme le semble indiqué ton image)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
for i=nbini to 1 step -1
sheets(i).delete
next i

Je le met où ??

[ouskel'n'or]

Tu avais une solution écrite ici, la seconde.
A toutes fins utiles

Edit
J'espère que tu as compris le code depuis le mois de mars
Je vais d'ailleurs effacer ta question dans Contribuez qui montre que tu n'avais alors pas compris

[FCL31]

Tu avais une solution écrite ici, la seconde.

Désolé, je ne vois pas se que tu veu que je mette

J'espère que tu as compris le code depuis le mois de mars

Pas en totalité mais une partie quand même


Toujours est'il que je pense qu'il ne manque pas grand chose mais je sais pas quoi

une solution
avant d'importer tu compte le nombre d'onglet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nbini=sheets.count

Tu importe uniquement l'onglet qui t'intéresse
(la ca dépend de ton code)

Et ensuite tu supprime les onglet initiaux (en partant du principe que tu importe les onglets a la suite comme le semble indiqué ton image)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
for i=nbini to 1 step -1
sheets(i).delete
next i

J'ai essayé mais sa marche pas : sa met met tout sur la même feuille
(Je l'ai peut être mal placé)

[Krovax]

Montre nous ou tu la placé mais avant tu peus essayer le mode pas a pas et essayer de voir comment le code évolue et modifie les classeur étape par étape, tout en regardant la varleur de tes différentes variables (menue affichage afficher les variable locals)
VBA est un langage très simple a débuger puisque interprété, du coup profite en.

Par contre je ne voi pas l'interet de mettre le test sur le contenue de la feuille après l'avoir copié, surtout que ca réalise une nouvelle copie.
Tu copie toujours le même onglet?

[FCL31]

Voici se que je veux faire en pièce jointe

En espérant être plus explicite

[Krovax]

On va dire que tu n'a pas mios un gros bouton sur un onglet (je vais te le supprimer) mais que tu as fait une élégante barre d'outil personnalisé (au pire tu ne supprimera pas l'onglet1)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Sub Copie(CL2 As Workbook)
  cl2.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
end sub

tu ne veux rien faire de plus non? copier la première feuille du classeur CL2 dans le classeur actif, alors pourquoi tu te prend la tête avec un code donc je suppose que tu ne comprend que la moitié? (sinon tu ne copierai pas deux fois les chose)

Après c'est la macro qui l'apelle je te lassie essayer d'adapter ca, n'yant pas vu ton code il va faloir que tu adapte et que tu ne te contente pas d'un copié collé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
dim nbini as integer
nbini=thisworkbook.sheets.count
 
'tu ouvre tes classeur source
'tu copie les feuille avec
'Copie workbook("Nomduclasseur")
'ou
'call Copie(workbook("Nomduclasseur"))
'une fois que tu as fini
Application.DisplayAlerts = False
For i = nbini To 1 Step -1 'remplace le 1 par 2 si tu veux conserver le premier onglet avec ton bouton
ThisWorkbook.Sheets(i).Delete
Next i
Application.DisplayAlerts = True

Je te laisse lire le code, réfléchir, tester, adapter, lancer en mode pas a pas corrigé, et ensuite tu nous poste. Le code utilisé (pas forcément tout juste les moment pertinent), les problème que tu as pus constater, etc

[ouskel'n'or]

Je suppose le classeur au bouton et contenant cette macro ouvert

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub SubTest
Dim CL1 as workbook, CL2 as workbook, CL3 as Workbook
Dim FL1 as Worksheet, FL2 as worksheet, FLT as worksheet
    Set CL1 = Thisworkbook
    Set CL2 = Workbooks.open("Classeur2LàOùIlEst")
    Set FL1 = CL1.Worksheets("F1") 'F1 de Classeur1
    Set FLT = CL2.Worksheets("F1") 'F1 de Classeur2 'Instance temporaire
    FLT.Usedrange.copy FL1.range("A1")
    DoEvents
    ActiveWorkbook.close false
 
    Set CL3 = Workbooks.open("Classeur3LàOùIlEst")
    Set FL2 = CL1.Worksheets("F2") 'F2 de Classeur1
    Set FLT = CL3.Worksheets("F1") 'F1 de Classeur3 'Instance temporaire
    FLT.Usedrange.copy FL2.range("A1")
    DoEvents
    ActiveWorkbook.close false
    Set CL1 = nothing
    Set CL2 = nothing
    Set CL3 = nothing
    Set FL1 =  nothing
    Set FL2 =  nothing
    Set FLT =  nothing
End sub

Pas testé. Tu peux faire ça pour moi ?
Adapte les noms

[FCL31]

N'y a t'il pas simplement de faire un truc du style :

"Supprimer les feuilles vide"

Je sais pas.

[ouskel'n'or]

Pour savoir si une feuille est vide tu testes la dernière cellule renseignée de la feuille et si cette cellule = A1 et qu'elle est vide c'est que la feuille... est vide
En substance, code proposé par SilkyRoad il y a deux ou trois ans :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if worksheets("feuil3").usedrange.address = "$A$1" and range("$a$1") = "" then Msgbox "La feuille est vide !"

Et laisse bien la majuscule à la première proposition (avec" $a$1", c'est pas bon ou alors il faut changer le code) Après, tu sauras bien te débrouiller avec delete, non ?

Edit
Par curiosité et pour savoir si je dois persister à donner des réponses, tu as testé mon dernier code ?
S'il ne fonctionne pas, tu le dis, il n'y a que pour toi que c'est embêtant

[FCL31]

Edit
Par curiosité et pour savoir si je dois persister à donner des réponses, tu as testé mon dernier code ?
S'il ne fonctionne pas, tu le dis, il n'y a que pour toi que c'est embêtant

J'ai effectivement testé et sa marche pas (peut être que je l'ai mal placé)

Par contre, j'ai revu un peu le code et j'ai fais ca :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public msg As String
 Sub Appel() 'A ADAPTER
Dim Chemin As String
    Application.ScreenUpdating = False
        Chemin = Recherche.TextBox1.Text
        Ouvrir Chemin
            Application.ScreenUpdating = True
    If msg <> "" Then _
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub
Sub Ouvrir(Chemin As String)
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
    Application.DisplayAlerts = False 'Evite les messages d'Excel
    'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
    Application.EnableEvents = False
        NomFich = Dir(Chemin & "*.xls")
        If NomFich = "" Then
             MsgBox "Aucun fichier trouvé dans " & Chemin
             Exit Sub
        End If
        Do While NomFich <> ""
            Set CL2 = Workbooks.Open(Chemin & NomFich)
            DoEvents
            Copie CL2
            CL2.Close False
            DoEvents
            ThisWorkbook.Save 'enregistrement du classeur après chaque copie
            DoEvents
            NomFich = Dir
        Loop
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub
Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, derlig As Long
For Each LaFeuille In CL2.Worksheets
 LaFeuille.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
        End If
    Next LaFeuille
On Error Resume Next
Sheets("feuil1").Delete
End Sub

Les principale modif ont été apporté vers la fin du code.

Toutefois, sa ne marche qu'avec 2 fichiers Excel et je sais pas comment faire pour que sa marche avec X fichiers



De plus, j'ai mis se code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("feuil1").Delete

afin de supprimer le feuille "feuil1" même si il y a des données dans la feuille.
Mais personne ne sais comment faire pour supprimer toutes les feuille vierge du classeur ??

[aalex_38]

Mais personne ne sais comment faire pour supprimer toutes les feuille vierge du classeur ??

On ne peut pas supprimer toutes les feuilles d'un classeur, il doit toujours y avoir au moins une feuille, normal non ?


Un code pour ouvrir un nouveau classeur avec une seule feuille :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Ajoute1_Onglet()
    Dim res As Long: res = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Workbooks.Add
    Application.SheetsInNewWorkbook = res
End Sub

[FCL31]

On ne peut pas supprimer toutes les feuilles d'un classeur, il doit toujours y avoir au moins une feuille, normal non ?

Je cherche pas a supprimer toutes le feuilles mais seulement celle qui sont vierge

Un code pour ouvrir un nouveau classeur avec une seule feuille :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Ajoute1_Onglet()
    Dim res As Long: res = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Workbooks.Add
    Application.SheetsInNewWorkbook = res
End Sub

Désolé mais je ne vois pas en quoi ce code peut me servir dans se cas présent (mais sa peu servir pour une autre application : je vais garder ce code dans un coin)


Voici le fichier en pièce jointe

.