Import .xls vers une feuille et une seconde avec filtre

Désolé MFerrend, mais mon message reste bloqué dans la boîte d'envoie ?

Je continue ici..

En fait, ce n'est pas la colonne Q qu'il faut tester, mais X.

Alors oui, c'était volontaire dans le sens de comprendre les choses, avec ton code, c'était une base je voulais volontairement "modifier". Du moins à mon échelle mais c'était dans l'idée, que si jamais mon fichier données évolue, comme ma colonne qui est la facteur de trie, je sois capable d'adapter le code.

Sur LISTING M. ton en-tête est en R9:AS9, elle est entourée de vides. Pour que tout fonctionne sans problème il faut juste que Q8:AT8 reste vide, Q8:Q... vide et AT8:AT... vide, et ta plage est bien délimitée sur 3 côtés

LISTING P. est décalée : S9:AT9, mais est également entourée de vides sur 3 côtés : ligne 8, colonne R et colonne AU.

Si tout demeure ainsi, pas de problème ! Il faut donc tester la colonne 24 (X) et non 17. et prendre comme cible R10 et S10.

Bon alors là j'ai un peu de mal à comprendre, car j'ai bien modifier la ligne :

Select Case tablo1(i, 24)

et

With ThisWorkbook.Sheets("LISTING P.").Range("S10")

et

With ThisWorkbook.Sheets("LISTING M.").Range("R10")

Pour autant, sa m'efface bien mes entêtes en ligne 9, pourtant il devrait copier les colonnes de "Données" en A2 et les collés en R10 non ? Sans rien faire au dessus.

Cordialement

Voilà la procédure entièrement rectifiée :

Sub Copie(x As String)
    Dim NewBook As Workbook, tablo1, i&, tablo2(), tablo3(), n&, m&
    Set NewBook = Workbooks(x)
    tablo1 = NewBook.Sheets("Feuil1").Range("A1").CurrentRegion
    For i = 2 To UBound(tablo1)
        Select Case tablo1(i, 24)
            Case "PANNEAUX", "PLEXI", "STRAT"
                ReDim Preserve tablo2(n)
                tablo2(n) = WorksheetFunction.Index(tablo1, i, 0)
                n = n + 1
            Case "MASSIF"
                ReDim Preserve tablo3(m)
                tablo3(m) = WorksheetFunction.Index(tablo1, i, 0)
                m = m + 1
        End Select
    Next i
    With ThisWorkbook.Sheets("LISTING M.").Range("R10")
        .CurrentRegion.Offset(1).ClearContents
        If n > 0 Then .Resize(n, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo2))
    End With
    With ThisWorkbook.Sheets("LISTING P.").Range("S10")
        .CurrentRegion.Offset(1).ClearContents
        If m > 0 Then .Resize(m, UBound(tablo1, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(tablo3))
    End With
    NewBook.Close False
End Sub

Dans tablo1 on prend toute la plage source, si ses dimensions changent ça suit.

On parcourt à partir ligne 2 (passer sur la ligne 1 n'avait pas d'incidence, le test y est de tout façon négatif, mais ça économise le passage...)

On teste sur la colonne 24 (=X) : là si ça change, il faudra changer pour le numéro de colonne à tester.

Lors de l'affectation on cible R10 et S10 sur les feuilles car ce sont les cellules à partir desquelles on dimensionne les plages cibles sur la taille du nombre de lignes prélevées et du nombre de colonnes.

Mais la Région courante inclut la ligne 9, donc pour l'effacement, on y procède en décalant d'une ligne pour ne pas toucher ta ligne d'en-tête.

Cordialement.