Macro pour lire des zones précises non continues.

 '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

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