Feuil et nom

**sergio_gr66** · 02/06/2009, 10h19

Bonjour a tous,

Je suis en train de faire l'automatisation d'une base de données d’un fichier Excel, mais j’un problème.
La macro dans mon fichier Excel cherche tous les fichiers *.XLS dans un répertoire, après elle écrit l'adresse et après elle ouvre le premier fichier.
Mon problème c'est que je veux que ma macro me dit combien il y a de feuilles dans ce fichier Excel et aussi copie le nom de chaque feuille dans une colonne de ce fichier.

Voici le code de ma macro :

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
Sub CHERCHER()
 
'elimina los datos de la busqueda anterior
Cells.Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
 
With Application.FileSearch
    .NewSearch
    .LookIn = "F: \DESSINS"
    .SearchSubFolders = False
    .Filename = "*.XLS"
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
        MsgBox "Il y a " & .FoundFiles.Count & _
        " fichiers(s) trouves."
        For i = 1 To .FoundFiles.Count
            Range("a" & i).Select
            ActiveCell.FormulaR1C1 = .FoundFiles(i)
            Range("b" & i).Select
            ActiveCell.FormulaR1C1 = "=HYPERLINK(RC[-1],""FICHIER"")"
            Range("b" & i).Select
 
            'abre el primer archivo encontrado
            Workbooks.Open Filename:=.FoundFiles(i)
            ActiveWindow.Visible = True
 
            'Cambia a la primera hoja del archivo
            Worksheets(1).Activate
            Sheets(1).Select
 
 
            'Muestra el nombre de la primera hoja
            'MsgBox ActiveCell.Worksheet.Name
            Windows("EXPERIMENTO.xls").Activate
            Range("c" & i).Activate
            ActiveSheet.Paste
            Windows("EXPERIMENTO.xls").ActivatePrevious
 
 
            'la siguiente linea cierra el archivo *.XLS
            ActiveWindow.Close
 
 
        Next i
    Else
        MsgBox "Il n'y a pas fichier Excel, le dossier c'est pas correct."
    End If
End With
End Sub

Merci beacoup a tous

**DeaD78** · 02/06/2009, 10h45

Bonjour,

Après avoir activé ton premier classeur qui a été trouvé, il suffit d'un

Code :

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

Sheets.count

pour trouver le nombre de feuilles qu'il y a dedans.

Après, en ce qui concerne le nom de ces feuilles, tu peux faire :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
 
Dim Sht As Worksheet
Dim i As Integer
 
i = 1
 
For Each Sht In ActiveWorkbook.Worksheets
    Workbooks("BlaBla").Worksheets("Feuil1").Cells(1, i).Value = Sht.Name
    i = i + 1
Next
 
End Sub

Et voilà.

Bonne journée !

EDIT : pense au balises

Sinon, c'est vraiment indigeste

En ce qui concerne ce que je viens de te proposer, le nom des feuilles est copié dans le classeur "BlaBla", dans la feuille "Feuil1". A toi d'adapter.

**sergio_gr66** · 02/06/2009, 14h18

Salut Dead78, merci ça marche

est ce que c'est possible d'afficher dans la colonne C par exemple 1,si il trouve dans feuille (trouvé avant) le nom TOTO1 (ou 1 si il trouve TOTO2 ou TOTO3), 2 si il trouve TOTO1 et TOTO2 ou,...3 TOTO1 et TOTO2 et TOTO3,

**DeaD78** · 02/06/2009, 14h39

Re,

Ben de rien. Pour la remarque seconde, c'est possible. Bref, disons que tu veux ton résultat dans la cellule C1.

Tu peux mettre quelque chose dans le goût :

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
Sub test()
 
Dim cpt As Integer
 
cpt = 0
 
For i = 1 To Sheets.Count
    If Cells(1, i).Value = "Toto1" Or Cells(1, i).Value = "Toto2" Or Cells(1, i).Value = "Toto1" Then
        cpt = cpt + 1
    End If
Next
 
     Range("C1").Value = cpt
 
End Sub

Bonne aprèm !

**sergio_gr66** · 02/06/2009, 17h30

Bonjour,
excuse moi, mais je ne puex pas faire marcher le denier chose, je te montre le code:

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Sub CHERCHER()
 
'elimina los datos de la busqueda anterior
Cells.Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
 
'Elimina la configuracion de las fuentes
Cells.Select
Selection.Font.Bold = True
Selection.Font.Bold = False
 
 
 
With Application.FileSearch
    .NewSearch
    .LookIn = "F:\DESSINS"
    .SearchSubFolders = False
    .Filename = "*.XLS"
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
        MsgBox "Il y a " & .FoundFiles.Count & _
        " fichiers(s) trouves."
        For i = 1 To .FoundFiles.Count
            Range("a" & i).Select
            ActiveCell.FormulaR1C1 = .FoundFiles(i)
            Range("b" & i).Select
            ActiveCell.FormulaR1C1 = "=HYPERLINK(RC[-1],""FICHIER"")"
            Range("b" & i).Select
 
            'abre el primer archivo encontrado
            Workbooks.Open Filename:=.FoundFiles(i)
            ActiveWindow.Visible = True
 
            'Cambia a la primera hoja del archivo
            Worksheets(1).Activate
 
            Dim Sht As Worksheet
            Dim a As Integer
 
            a = 4
 
            For Each Sht In ActiveWorkbook.Worksheets
            Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = Sht.Name
            a = a + 1
            '_________________________
            
 
            Dim cpt As Integer
            cpt = 0
            For a = 4 To Sheets.Count
                If Cells(i, a).Value = "Datas" Then
                    cpt = cpt + 1
                End If
                Next
                    Range("c" & i).Value = cpt
 
 
            '_________________________
            Next
 
            Windows("EXPERIMENTO.xls").ActivatePrevious
 
 
            'la siguiente linea cierra el archivo *.XLS
            ActiveWindow.Close
 
        Next i
    Else
        MsgBox "Il n'y a pas fichier Excel, le dossier c'est pas correct."
    End If
 
 
        'Inserta 3 lineas para agregar los titulos a las columnas
        Rows("1:3").Select
        Selection.Insert Shift:=xlDown
        Range("A12").Select
        ActiveSheet.Shapes("Button 1").Select
        Rows("3:3").Select
 
End With
    'agrega los nombres a las columnas y sus caracteristicas
    Selection.Font.Bold = True
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "ADRESSE"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "HYPER LIEN"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "FEUILLES DANS LES FICHIERS -->"
 
 
 
    Range("D3").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
 
 
 
End Sub

merci

**DeaD78** · 02/06/2009, 17h58

Re,

N'imbrique pas les 2 morceaux de code que je t'ai donnés et ça devrait marcher.

En gros, tu devrais avoir :

Code :

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

1
2
3
4
5
6
For
'1er code
Next
For
'2ème code
Next

De plus, n'utilise pas a comme itérateur pour le 2ème code si tu l'as déjà utilisé pour le 1er. Sait-on jamais, je fais ça par habitude. Appelle-le autrement

Dis-moi si ça marche

**sergio_gr66** · 03/06/2009, 13h47

Bonjour:

est ce que c'est possible de faire macro pour ouvrir automatiquement les fichier ou il trouve les 3 toto(1,2,3) et qu'il copie toutes les lignes qui existent dans ces fichiers mais pas toutes les colonnes (depuis colonne A jusqua colonne G)??
Mais les fichiers ont different quantité de lignes, et je besoin qu'il sélectionne solemment les lignes depuis 2 jusqua il ne trouve plus de data.

Merci a tous pour votre atention