Suppression chaine de caractères et export du résultat

Bonjour,

Voici mon besoin: (cf fichier joint)

1- Je souhaite supprimer toutes les lignes de la colonne C qui ne contiennent pas les chaines de caractères suivantes:

UT_BORDEAUX

UT-DIJON

UT-LIMOGES

CAHORS

Ci-dessous le code qui fonctionne mais comment faire pour éviter de saisir toutes les villes précédées de UT dans le code?

je voudrais un code qui dit:

si je trouve la chaine de caractères suivante UT-NOM d'UNE VILLE , je conserve la ligne

sub suppression ()
' Suppression de toutes les lignes autres que "UT-BORDEAUX";"UT-DIJON"; "UT-LIMOGES" "CAHORS" dans la colonne C"
    Dim i As Integer
' blocage de l'affichage ecran
    Application.ScreenUpdating = False
    For i = Range("C65536").End(xlUp).Row To 2 Step -1 ' To 2 Step -1 car ligne entête a conserver

    'Cells(i, 3) signifie: toutes les cellules de la colonne C qui sont différentes de <> ...
        If Cells(i, 3).Value <> "UT-BORDEAUX" And Cells(i, 3).Value <> "UT-DIJON" And Cells(i, 3).Value <> "UT-LIMOGES" And Cells(i, 3).Value <> "CAHORS" Then Rows(i).Delete 'row = ligne

   Next i
end sub

2- Ensuite je veux copier/coller dans de nouveaux classeurs les lignes restantes en autant de fichiers qu'il y a de Ville tout en conservant l'entête

ex:

toutes les lignes contenant dans la colonne C UT-BORDEAUX je copie/colle ces lignes dans un nouveau classeur en conservant l'entête

idem pour UT-DIJON, etc.....

merci d'avance

Bonjour,

On va déjà répondre à la question 1

Sub suppression()
' Suppression de toutes les lignes qui ne commencent pas par "UT-"  ou "CAHORS" dans la colonne C"
    Dim i As Integer, k%
' blocage de l'affichage ecran
    Application.ScreenUpdating = False
    'inutile de recalculer Range("C65536").End(xlUp).Row à chaque fois... On mémorise !
    k = Range("C65536").End(xlUp).Row
    For i = k To 2 Step -1 ' To 2 Step -1 car ligne entête a conserver

    'Cells(i, 3) signifie: toutes les cellules de la colonne C qui sont différentes de <> ...
        If Left(Cells(i, 3), 3) <> "UT-" And Cells(i, 3) <> "CAHORS" Then Rows(i).Delete 'row = ligne
   Next i
End Sub

Pour la question 2 l'en-tête est pas un problème mais tu vas les nommer comment tes nouveaux fichiers ?

A+

Rebonjour,

merci pour la question 1

j'ai compris la mécanique

JE TESTE CE SOIR

Pour poursuivre sur la 2è question

Idéalement, je souhaiterais exporter les résultats dans de nouveaux classeurs

en les enregistrant sous un répertoire bien précis ("ex Mes documents)

et les nommant : nom de ville_date du jour au format jjmmaaaa.xlsx

ex : pour UT DIJON : UT-DIJON_13102012.xlsx

pour CAHORS : CAHORS_13102012.xlsx

j'espère que l'explication est suffisamment claire?

Bonjour,

C'est clair, mais il faudra un peu de patience car ça demande un peu plus de 3 lignes et demain c'est dimanche...

A+

Evidemment je comprends que ce n'est pas si simple

donc bonne fin de WE

A+

Bonjour,

Hum... T'as préparé l'aspirine ?

Suite et fin :

Sub Export()
Dim i%, ii%, k%, myWay$, NomVille$, EndNam$, Champs, Vill, Tmp
' Blocage de l'affichage ecran
Application.ScreenUpdating = False
' On mémorise la ligne entête a conserver
Champs = Range("A1:G1")
' On mémorise la colonne des villes dans un Array
Vill = Range("C2:C" & Range("C65536").End(xlUp).Row)
' On crée Liste sans doublons
Set mondico = CreateObject("Scripting.Dictionary")
    For i = LBound(Vill) To UBound(Vill)
      mondico(Vill(i, 1)) = ""
    Next i
' On mémorise le nombre de villes différentes (donc le nombre de classeurs à créer)
k = mondico.Count
' On mémorise cette liste de ville dans un Array (Tmp)
Tmp = mondico.keys

' On mémorise le chemin de sauvegarde (Attention à actualiser avec ta config)
myWay = "C:\Users\Utilisateur\Desktop\Documents\"
' On mémorise la fin du string qui constituera le chemin de sauvegarde
EndNam = "_" & Replace(Date, "/", "") & ".xlsx"

    ' Pour chaque ville différente
    For i = 1 To mondico.Count
        ' On récupère le nom de la ville sur laquelle on va travailler
        NomVille = Tmp(i - 1)
        ' On instancie une nouvelle feuille dans le classeur de W
        Set WC = Worksheets.Add
            ' On y colle la ligne d'en-tête
            WC.Range("A1:G1") = Champs
            ' On ajuste la largeur de la colonne 5
            WC.Columns(5).ColumnWidth = 42
            ' On initialise le compteur de ligne
            ii = 2
            ' A partir de la feuille de W
            With Sheets("Feuil1")
                ' Pour chaque élément de l'Array (Chaque ligne de Feuil)
                For j = LBound(Vill) To UBound(Vill)
                    ' On vérifie si le nom de la ville correspond à NomVille
                    If Vill(j, 1) = NomVille Then
                        ' Et si c'est le cas on copie toute la ligne dans la feuille cible (WC)
                        .Range(.Cells(j + 1, 1), .Cells(j + 1, 7)).Copy WC.Cells(ii, 1)
                        ' Et on incrémente le compteur de ligne
                        ii = ii + 1
                    End If
                Next j
            End With
        ' Création d'un nouveau classeur
        WC.Move
        ' On enregistre le nouveau classeur
        ActiveWorkbook.SaveAs Filename:=myWay & NomVille & EndNam
        ' Et on le ferme
        Workbooks(NomVille & EndNam).Close
    Next ' ville suivante
    MsgBox "C'est fini !"
End Sub

Bon dimanche !

ouh là !!!

D'abord à nouveau un grand merci !

En m'aidant de l'aspirine, Il faut que je me pose un peu pour décrypter tout ce code

et pouvoir ainsi l'adapter à mon programme.

En tout cas, les commentaires insérés dans le code vont m'être très utiles

Je vous tiens au courant

Une grande leçon d'humilité que je viens de prendre

Bon Dimanche