Macro pour lire des zones précises non continues.

[thierryppp]

Bonsoir,
Je ne suis pas un grand expert d'Excel et du VBA alors merci de votre indulgence.

Je souhaite lire le fichier excel que je mets en pièce jointe.HOMOL_DM2_DI_1 0 8-v1 0 (3).xlsm
J'aimerai lire la zone "Filesystems" (ligne 32 dans ce fichier) des onglets 01_DM2 Front 1 et 01_DM2 Middle 1 colonnes par colonnes
Exemple la colonne "User Owner" des zones "applicatif" et "produits" que je voudrais copier en une seule colonne sans les blancs (lignes vides) dans la feuille "feuil1" contenant la macro.
Puis les autres colonnes "Group Owner" ... pas spécialement dans l'ordre initial...

Avec le bout de code suivant j'arrive à ouvrir le fichier puis lire la bonne feuille par contre après ça ne marche pas.

 'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)
 Set WbkColle = ThisWorkbook
  'A adapter : Nom des entêtes de colonnes à importer
 Colonnes = Array("Point de Montage", "User Owner", "Group Owner", "Taille")
 
  'Sélection du fichier
 Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
  'En cas de clic sur "ANNULER"
 If Fichier <> False Then
    'On ouvre le fichier en question
   Set WbkCopy = Workbooks.Open(Fichier)
    With WbkCopy.Sheets("01_DM2 Front 1") '==> ADAPTER NOM de la feuille
     'Boucle sur toutes les entêtes des colonnes
     For Col = 1 To .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
        'teste si l'entête correspond à un des noms des colonnes à copier
       Resultat = Application.Match(.Cells(1, Col), Colonnes, 0)
        'Si l'entête est trouvée (colonne à copier)
       If Not IsError(Resultat) Then
          'Copié - Collé ==> ADAPTER NOM de la feuille ou coller ("TRUC" à remplacer)
         .Columns(Col).Copy WbkColle.Sheets("Feuil1").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)
        End If
      Next Col
    End With
    WbkCopy.Close
  End If
Set WbkCopy = Nothing
Set WbkColle = Nothing
End Sub

De plus les colonnes sont lus dans l'ordre et avec les lignes vides alors que je voudrais les lire dans un autre ordre et je pense en lisant un peu le forum qu'il faut mieux prendre la méthode Find pour lire la zone "Filesystems" et après je ne vois pas trop comment lire la suite.

Merci de votre aide.

Thierry.

 

[Bebere]

Re : Macro pour lire des zones précises non continues.

bonjour Thierryppp
bienvenue
il faut un mot de passe

 

[thierryppp]

Re : Macro pour lire des zones précises non continues.

Bonjour Bebere,
Ou faut-il un mot de passe sur le code ou sur le fichier joint ?
Merci,
Thierry.

 

[thierryppp]

Re : Macro pour lire des zones précises non continues.

Bebere,

Si c'est le code je le remets...

 'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)
 Set WbkColle = ThisWorkbook
  'A adapter : Nom des entêtes de colonnes à importer
 Colonnes = Array("Point de Montage", "User Owner", "Group Owner", "Taille")
 
  'Sélection du fichier
 Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
  'En cas de clic sur "ANNULER"
 If Fichier <> False Then
    'On ouvre le fichier en question
   Set WbkCopy = Workbooks.Open(Fichier)
    With WbkCopy.Sheets("01_DM2 Front 1") '==> ADAPTER NOM de la feuille
     'Boucle sur toutes les entêtes des colonnes
     For Col = 1 To .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
        'teste si l'entête correspond à un des noms des colonnes à copier
       Resultat = Application.Match(.Cells(1, Col), Colonnes, 0)
        'Si l'entête est trouvée (colonne à copier)
       If Not IsError(Resultat) Then
          'Copié - Collé ==> ADAPTER NOM de la feuille ou coller ("TRUC" à remplacer)
         .Columns(Col).Copy WbkColle.Sheets("Feuil1").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)
        End If
      Next Col
    End With
    WbkCopy.Close
  End If
Set WbkCopy = Nothing
Set WbkColle = Nothing
End Sub

Peux tu lire le fichier ?
Merci,
Thierry.

 

[Bebere]

Re : Macro pour lire des zones précises non continues.

Le fichier oui,mais quand je veux aller dans l'éditeur,clic droit onglet et visualiser code
en plus erreur automation à l'ouverture,mais peut être pas grave si accès à l'éditeur

 

[thierryppp]

Re : Macro pour lire des zones précises non continues.

Re Bonjour,
Oui c'est pas très clair.

Donc ce que j'aimerai c'est dans la partie du fichier correspondant à "Filesystems" ligne 32 pour ce fichier mais la ligne peut changer :
Prendre les 4 colonnes : (ligne 33) voir image ci dessous


Et les remettre dans ce format :


Merci,

Thierry.

 

[Bebere]

Re : Macro pour lire des zones précises non continues.

Tu devrais savoir qu'i y a un mot de passe(password) pour pouvoir ouvrir l'éditeur vba

 

[thierryppp]

Re : Macro pour lire des zones précises non continues.

Bonjour,

Oui il y a un mot de passe : zhiping mais justement je ne peux pas modifier ce code VBA très complexe.

Mais simplement faire une macro dans un autre fichier qui ouvre le fichier finalisé HOMOL_DM2_DI_1 0 8-v1 0 (3).xlsm‎ puis par exemple dans la feuille "01_DM2 Front 1" la partie "Filesystems pour prendre les 4 colonnes et mettre le résultat demandé (4 colonnes dans un autre ordre sans les lignes vides) dans ce nouveau fichier par exemple dans la feuil1.
Merci,

Thierry.

 

[thebenoit59]

Re : Macro pour lire des zones précises non continues.

Je suppose que les colonnes resteront toujours identiques en terme de position.
Je te propose la solution jointe :

Option Explicit
Sub Export()
'- Déclaration des variables
Dim fB As Worksheet, fR As Worksheet
Dim vD As String, vF As String
Dim lD As Long, lF As Long
Dim d As Object
Dim c As Variant, i As Variant
Dim a
 
'- Enregistrement des objets
Set fB = Feuil1: Set fR = Feuil2
vD = "Filesystems": vF = "Répertoires à créer"
Set c = fB.Cells.Find(vD, lookat:=xlWhole): If Not c Is Nothing Then lD = c.Row
Set c = fB.Cells.Find(vF, lookat:=xlWhole): If Not c Is Nothing Then lF = c.Row
Set d = CreateObject("Scripting.Dictionary")
 
'- Création de la bibliothèque
With fB
For Each c In .Range(.Cells(lD + 1, 3), .Cells(lF - 1, 3))
    If c.Value <> "" Then d(c.Offset(, 1).Value & "%" & c.Offset(, 2).Value & "%" & c.Value & "%" & c.Offset(, 3).Value) = ""
Next c
End With
 
'- Retranscription sur la feuille Résultat
With fR
    If d.Count > 0 Then
        i = 0
            For Each c In d.Keys
                a = Application.Transpose(Split(c, "%"))
                    .[a1].Offset(i, 0).Resize(, 4) = Application.Transpose(a)
        i = i + 1
            Next c
    End If
End With
End Sub

J'avais commencé avant d'obtenir ton mot de passe.
La méthodologie est la suivante :

On trouve le numéro de ligne de Filesystems et de Répertoires à créer, qui est la catégorie suivante.
On boucle les lignes entre ces deux catégories et on enregistre les valeurs dans un dictionary, en mettant dans l'ordre que tu as demandé. On ajoute un "%" entre chaque texte.
On exporte le dictionary dans un tableau, en séparant le texte avec Split(, "%"), voilà l'utilité du %.
On transpose le résultat dans la feuille Résultat.

Essaye d'adapter ça pour que tu puisses boucler les différentes feuilles.

Je viens de voir que tu as également posté sur le forum Excel Downloads, alors je mets ma proposition ici également.

 

[thierryppp]

Re : Macro pour lire des zones précises non continues.

Benoit,
Oui j'avais mis la demande sur les 2 forums, car je ne savais pas lequel était le mieux dans les réponses.
Je vois que les gens vont su les deux donc ils doivent être équivalent.
Merci pour l'explication et le code il faut que j'analyse cela et que je teste.
Pour le moment je n'ai pas trop le temps.
Je te tiens au courant.
Merci
Thierry.