Discussion :

[Creavern]

Bonjour,

Je viens vous demander votre aide après deux jours et demi de travail sur une maccro, qui je l'avoue finis par me faire tourner en rond, j'aimerais ainsi vous demander votre soutien dans ma quête de Maccro

Je présente le soucis :

Je possède 830 Fichiers dans lesquels sont réprésentés au sein d'un Onglet "Représentation Baie" un Schéma représenté par une fusion de cellules proportionnelle à la taille de l'équipement présent dans cette baie (Voir pièce jointe/Screen N°1).

Ainsi le screen 1 représente mon origine

Chacun des 830 fichiers Excel est au même format et dans chaque cas je ne m'occupe que de la représentation de la baie dîtes projeté sur le screen .

De ces baie je souhaite synthétiser l'information vers un seul même fichier excel au format matriciel représentant un des 830 fichier par Ligne et une unité de place dite "1U" par colonne où serait écris le nom de l'équipement en place(Voir pièce jointe/Screen N°2)

Ainsi le screen 2 représente mon objectif .

Alors, la difficulté est double, d'une part je dois récupérer la valeur des cellules fusionnées dans les 830 fichiers (chaque cellules fusionnées étant représentative donc d'un équipement et de la place que ce dernier prend en "U".
D'autre part je dois réussir à organiser ma maccro pour que j'obtienne un résultat sous forme de matrice de synthèse de mes fichiers .

Je vous met en pièce jointe un exemple d'un fichier source ( parmis les 830 ) et mon fichier Projet VBA "VBProject" .

Enfin voici mon code à mon stade actuel d'avancement, où je fais face à une erreure :

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
Sub Hola()
    'Définition des variables
 
    Dim Fname As Variant
    Dim oApp As Object
    Dim wb_master
    Dim wb_toOpen
    Dim cel As Range
    Dim col As String
 
 
    Worksheets("Feuil2").Activate
        'Ouverture d'un explorateur de fichier permetant la multisélection
 
        Fname = Application.GetOpenFilename("xlsx Files(*.xlsx),*.xlsx", MultiSelect:=True)
 
        'Création de l'identifiant(1 par ligne) lié à chaque chemin de fichier. ET parcours des fichiers
 
        For i = LBound(Fname) To UBound(Fname)
            Cells(i, 1).Value = Fname(i)
 
        'Ouverture des DISK
        Set wb_toOpen = Workbooks.Open(Fname(i), ReadOnly:=True)
        Set wb_master = ThisWorkbook
 
         'J'active la page contenant la baie recherchée
 
         With wb_toOpen.Worksheets("Représentation baie")
 
        'Je créer une boucle pour récupérer les informations de la ligne 15 à 106 dans la colonne O(17) des DISKs
 
                For j = 15 To 106
                For Each cel In .Range(Cells(j, 17))
                        cel.Select
                            If Selection.MergeCells = True Then
                                wb_master.Worksheets("Feuil2").Cells(i, j) = Selection.Value
 
        'Fermeture du fichier DISK
                wb_toOpen.Close SaveChanges:=False
 
                            End If
                        Next cel
                    Next j
               End With
            Next i
        End Sub

Enfin, je vous remercie d'avance de votre aide !

[clementmarcotte]

Bonjour,

Il ne faut jamais utiliser de cellules fusionnées. Cellule fusionnée veut dire problème par-dessus problème par-dessus problème.
Dans des cellules fusionnées, l'adresse c'est celle de la première cellule.

Presque personne n'ouvre les fichiers balancés avec la première question ; et il y en a encore moins qui ouvrent les fichiers de macros.

Et Excel n'est pas un traitement de texte.

[Creavern]

Merci de ton intervention des plus utiles...., néanmoins j'ai trouver une solution a mon problème.
Les cellules fusionnées induisent certes des problèmes mais des traitements sont possibles, pointer le problème du doigt n'était pas une solution Or je ne suis pas venu ici pour écouter quelqu'un me rappeler a quels problèmes je fais face, en effet, ces problèmes étaient déjà cités.

Ainsi je pose ici mon code afin que je puisse aider certaines personnes dans mon cas.

Pour rappel : Mon objectif était de récupérer la valeur de cellules fusionnées dans plusieurs fichiers excel afin de la transposer dans un tableur unique de synthèse.

Voici 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
 
Sub Hola()
    'Définition des variables
 
    Dim Fname As Variant
    Dim oApp As Object
    Dim wb_master
    Dim wb_toOpen
    Dim Cel As Range
    Dim Col As String
 
    Worksheets("Feuil2").Activate
        'Ouverture d'un explorateur de fichier permetant la multiselection
 
    Set wb_master = ThisWorkbook
 
    Fname = Application.GetOpenFilename("xlsx Files(*.xlsx),*.xlsx", MultiSelect:=True)
 
        'Création de l'identifiant(1 par ligne) lié à chaque chemin de fichier. ET parcours des fichiers
 
 
    For I = LBound(Fname) To UBound(Fname)
        Cells(I + 18, 1).Value = Fname(I)
 
        Set wb_toOpen = Workbooks.Open(Fname(I), ReadOnly:=True)
        With Worksheets("Représentation baie")
            .Activate
           For A = 15 To 106
                        CelName = "Q" & CStr(A)
 
                        ActiveSheet.Cells(A, 15).Select
                            If Selection.MergeCells = True Then
 
                        For Each Cel In .Range(CelName)
                            Cel.Select
 
                            If Selection.MergeCells = True Then
                                wb_master.Worksheets("Feuil2").Cells(I + 18, A - 13) = Selection.Value
                            End If
                            If Selection.MergeCells = False Then
                                wb_master.Worksheets("Feuil2").Cells(I + 18, A - 13) = "_"
                            End If
                    Next Cel
                End If
            Next A
        End With
        wb_toOpen.Close SaveChanges:=False
    Next I
End Sub

Enfin voici le fichier Macro VBA pour qui est intéressée
VBProject.xlsm