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.
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.
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 '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
Merci de votre aide.
Thierry.
Partager