Extraire donnees colonnes en fonction nom colonne

Jarod51

XLDnaute Nouveau
Bonjour a tous,
J'ai un fichier Excel qui contient plusieurs colonnes et je voudrais extraire les données de certaines colonnes dans une autre feuille. Mon problème, c'est que les colonnes que je veux extraire ne sont pas forcement tout le temps au même emplacement et le nom devant les deux points varie. Ce qui est toujours pareil c'est ce que j'ai après les deux points. Je voulais savoir si il est possible d'extraire ces colonnes en fonction de leur nom et non pas en fonction de l'emplacement.
Par exemple:
Extrait toutes les valeurs dont le nom de la colonne est :100, :50, :25, etc...
J'avais commence a écrire une macro mais elle ne fonctionne que pour un emplacement unique de colonne :(
Public Sub extractCol()
Set range1 = Range("A : D, BI:BI, BQ:BQ,CL:CL,CM:CN,CT:CT,DB : DB")
range1.Copy
Set newbook = Workbooks.Add
ActiveCell.PasteSpecial Paste:=xlPasteValues
End Sub
 

Fichiers joints

Yurperqod

XLDnaute Occasionnel
Bonjour le forum

Un exemple de macro
VB:
Sub Macro()
    Dim col As Long
    Sheets("Feuille1").Copy
    For col = 1 To Rows(1).CurrentRegion.Columns.Count
    If Not InStr(Cells(1, col), ":") > 0 Then
    Columns(col).Delete
    End If
    Next
End Sub
 

Dugenou

XLDnaute Barbatruc
Supporter XLD
Bonjour,
On pourrait le faire avec un filtre élaboré, mais dans ton fichier exemple on a plusieurs colonnes avec : 25 ou : 12.5 etc..
Faut-il extraire toutes les colonnes qui correspondent au critère :25 ou bien seulement une d'entre elles ?
Peut-on imaginer que tu places un signe (X par exemple) sur une ligne au dessus de chaque colonne qu'il faut extraire ?

Cordialement
 

Jarod51

XLDnaute Nouveau
Salut Yuperqod,
Merci pour l'aide. J'ai testé le morceau de code en essayant d'y ajouter une condition, par contre, ca ne me garde pas par exemple uniquement les colonnes dont le nom est :100 et :50 :(.
VB:
Sub Macro()
    Dim col As Long
    Sheets("Feuille1").Copy
    For col = 1 To Rows(1).CurrentRegion.Columns.Count
    If Not (InStr(Cells(1, col), ": 100") > 0 And  InStr(Cells(1, col), ": 50") > 0) Then
    Columns(col).Delete
    End If
    Next
End Sub
 
Dernière édition:

Jarod51

XLDnaute Nouveau
Bonjour,
On pourrait le faire avec un filtre élaboré, mais dans ton fichier exemple on a plusieurs colonnes avec : 25 ou : 12.5 etc..
Faut-il extraire toutes les colonnes qui correspondent au critère :25 ou bien seulement une d'entre elles ?
Peut-on imaginer que tu places un signe (X par exemple) sur une ligne au dessus de chaque colonne qu'il faut extraire ?

Cordialement
Hello Dugenou,
En fait, je voudrais extraire toutes les colonnes qui correspondent au critere :25 , 12:5, etc... toutes celles qui ont un chiffre.
 

Dugenou

XLDnaute Barbatruc
Supporter XLD
Voir essai en PJ
avec un filtre élaboré, quelques formules pour les critères et la zone d'extraction et une (toute petite) macro pour lancer le filtre.
L'extraction peut être faite sur une autre feuille
Cordialement
 

Fichiers joints

Jacky67

XLDnaute Accro
Extrait toutes les valeurs dont le nom de la colonne est :100, :50, :25, etc...
J'avais commence a écrire une macro mais elle ne fonctionne que pour un emplacement unique de colonne :(
Bonjour,
A tester
VB:
Sub testJJ()
    Dim i As Long, x As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Resultat").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Sheets("Feuille1").Copy After:=Sheets(1)
    ActiveSheet.Name = "Resultat"
    For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
        If Not IsNumeric(Mid(Cells(1, i), InStr(Cells(1, i), ":") + 1, Len(Cells(1, i)))) Then
               Columns(Cells(1, i).Column).Delete
        Else
            x = Mid(Cells(1, i), InStr(Cells(1, i), ":") + 1, Len(Cells(1, i))) * 1
            If Not Int(x) = x Or x = 0 Then
                Columns(Cells(1, i).Column).Delete
            End If
        End If
    Next
    ActiveSheet.Shapes("Button 1").Cut
    Application.ScreenUpdating = True
End Sub
 

Fichiers joints

Jarod51

XLDnaute Nouveau
Bonjour,
A tester
VB:
Sub testJJ()
    Dim i As Long, x As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Resultat").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Sheets("Feuille1").Copy After:=Sheets(1)
    ActiveSheet.Name = "Resultat"
    For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
        If Not IsNumeric(Mid(Cells(1, i), InStr(Cells(1, i), ":") + 1, Len(Cells(1, i)))) Then
               Columns(Cells(1, i).Column).Delete
        Else
            x = Mid(Cells(1, i), InStr(Cells(1, i), ":") + 1, Len(Cells(1, i))) * 1
            If Not Int(x) = x Or x = 0 Then
                Columns(Cells(1, i).Column).Delete
            End If
        End If
    Next
    ActiveSheet.Shapes("Button 1").Cut
    Application.ScreenUpdating = True
End Sub
Salut Jacky67,
Merci bien pour la macro, ca marche. Par contre, pourrais tu m'expliquer un peu le code. Le resultat se fait sur le critere si la cellule contient un numerique apres le deux point alors selectionne la colonne, c'est bien ca? Y a t-il par exemple une possibilité de faire la meme chose si ce n'est pas un numerique ? Encore merci pour la macro.
 

Jarod51

XLDnaute Nouveau
re,
Voilà une version2 avec les X de sélection calculés : on considère que 1.26 et 0 sont des chiffres

Cordialement
J'aime bien ta solution, elle me convient aussi. J'ai juste une petite question. J'ai recopié la Macro3 sur une nouvelle feuille et lorsque je l’exécute j'ai une erreur: La méthode range pour la méthode global a échouée :( de quoi cela vient-il?
 

Yurperqod

XLDnaute Occasionnel
Salut Jacky67,
Le resultat se fait sur le critere si la cellule contient un numerique apres le deux point alors selectionne la colonne, c'est bien ca?
Y a t-il par exemple une possibilité de faire la meme chose si ce n'est pas un numerique ? Encore merci pour la macro.
C'est sur ce critère que fonctionne mon code VBA de mon premier message, non ?
Mon code VBA ne conserve que les colonnes dont la première cellule contient le caractère :
 

Dugenou

XLDnaute Barbatruc
Supporter XLD
la macro utilise une zone nommée dont la définition est dans le classeur d'origine
il faut définir une zone EtractVar : voir dans formules/gestionnaire de noms
 

Yurperqod

XLDnaute Occasionnel
Jarod51
Ton dernier souhait était
Y a t-il par exemple une possibilité de faire la meme chose si ce n'est pas un numerique ?
Que j'ai interprété comme ne garder que les colonnes qui contiennent :
 

Jacky67

XLDnaute Accro
Merci bien pour la macro, ca marche. Par contre, pourrais tu m'expliquer un peu le code
Re...
Je vais essayer
VB:
Sub testJJ()
    Dim i As Long, x As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Resultat").Delete ' on supprime la feuille si elle existe
    Application.DisplayAlerts = True
    On Error GoTo 0
    Sheets("Feuille1").Copy After:=Sheets(1) ' on fait une copie conforme de la feuille à traiter
    ActiveSheet.Name = "Resultat" ' et on la nomme résultat
    For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 ' on commence la boucle par la dernière cellule de la ligne 1
        If Not IsNumeric(Mid(Cells(1, i), InStr(Cells(1, i), ":") + 1, Len(Cells(1, i)))) Then ' on cherche les cellules de la ligne 1 non numerique
            Columns(Cells(1, i).Column).Delete ' et on supprime les colonnes correspondantes
        Else
            x = Mid(Cells(1, i), InStr(Cells(1, i), ":") + 1, Len(Cells(1, i))) * 1 ' on place dans X la valeur numerique de la cellule apprès le ": "(deux points+espace)
            If Not Int(x) = x Or x = 0 Then ' on ne prend en compte que les X avec decimale ou égale à zéros
                Columns(Cells(1, i).Column).Delete ' et on supprime les colonnes correspondantes
            End If
        End If
    Next
    'Ici il ne doit rester que les colonnes ou le nombre (en ligne 1) après les deux point
    'est un nombre entier supérieur à zéros
    ActiveSheet.Shapes("Button 1").Cut ' facutatif, supprime le bouton que j'ai placé en feuil1
    Application.ScreenUpdating = True
End Sub
Bon courage
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas