Condition sur une cellule

Version imprimable

Bonjour,

Je souhaite répartir mon fichier excel en deux distincs en fonction de la première colonne qui m'indique l'origine de la ville( Paris ou Marseille).

C'est à dire, si la ville de la colonne A est Paris, je copie cette ligne et la colle dans un nouveau fichier nommé PARIS.xls, et si c'est marseille, je copie colle toute la ligne dans le fichier Marseille.xls

Le code suivant devrait me permettre de parcourir cellule par cellule sur la première colonne ("ville") de mon fichier d'origine, en faisant une recherche de chaine de caractères, il me permet d'effectuer l'opération que je souhaite. Mais PROBLEM : Dans ma condition, elle fonctionne bien dans la condition IF, mais ne peut pas aller dans la condition ELSEIF....

Code:

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
Public Sub aliment()
 
Dim vierge_Marseille As Workbook, vierge_Paris As Workbook, EPI As Workbook
Dim Anc_Paris As Worksheet, Anc_Marseille As Worksheet
 
Workbooks.Open ("...CSV"), local:=True
Set EPI = Workbooks("....CSV")
Set origine = EPI.Worksheets("...")
 
Workbooks.Open (".....xls"), local:=True
Set vierge_Marseille = Workbooks("...xls")
Set Anc_Marseille = vierge_Marseille .Worksheets("ANCIENNE OFFRE")
 
Workbooks.Open ("...xls"), local:=True
Set vierge_Paris = Workbooks("....xls")
Set Anc_Paris = vierge_Paris.Worksheets("ANCIENNE OFFRE")
 
    origine.Activate
    NbligneTot = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To NbligneTot
        origine.Activate
        cellule = Range("A" & i).Activate
        If ActiveCell.Find(What:="MARSEILLE", After:=ActiveCell,    LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate Then
            ligne = ActiveCell.Row
            colonne = ActiveCell.Column
            Range("A" & ligne & ":W" & ligne).Select
            Selection.Copy
            Anc_Marseille.Activate
            debut = Range("B" & Rows.Count).End(xlUp).Row + 1
            Range("B" & debut).Select
            'copier coller en valeur
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
 
        ElseIf ActiveCell.Find(What:="PARIS", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
        , MatchCase:=False, SearchFormat:=False).Activate Then
            ligne = ActiveCell.Row
            colonne = ActiveCell.Column
            Range("A" & ligne & ":W" & ligne).Select
            Selection.Copy
            Anc_Paris.Activate
            debut = Range("B" & Rows.Count).End(xlUp).Row + 1
            Range("B" & debut).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
        End If
    Next
 
End Sub

:oops::oops::oops:
Merci d'avance de votre aide!!!

30/12/2013, 12h08
Philippe Tulliez

Bonjour,
S'il y a plusieurs lignes à exporter vers un nouveau classeur, le filtre avancé d'excel me semble plus simple à utiliser.
Tu peux t'inspirer de cette contribution/discussion qui semble correspondre à ce que tu cherches et où il y a commentaires et fichier à télécharger.
30/12/2013, 12h09
Marc-L

Bonjour,

ce serait plus simple et plus rapide en envisageant d'utiliser un filtre,
et avec l'Enregistreur de macros, base de code assurée …
30/12/2013, 12h58
Philippe Tulliez

Bonjour Marc,
Les deux filtres pourraient apporter le même résultat sauf que le filtre avancé permet l'exportation des lignes filtrées vers une autre feuille ou directement vers un autre classeur.
Pour ma part s'il s'agit d'exporter vers un nouveau classeur, je privilégie l'exportation vers une nouvelle feuille ou une feuille destinée à recevoir l'exportation sur le classeur où se trouve le code VBA, ce qui permet ensuite de déplacer la feuille vers un nouveau classeur (ce qui offre l'avantage d'obtenir la création du classeur sans code supplémentaire - un simple Sheets("Toto").Move ou Sheets("Toto").Copy) et ensuite il suffit de faire un SaveAs

Bonjour,

J'ai passé du temps à regarder les exemples que vous avez cité plus haut... mais ce n'est pas vraiment adapté à mon cas...
Je souhaite répartir les lignes du fichier d'origine, mais la coller dans les fichiers qui existent déja (donc sans recreer de nouveaux fichiers).
Et sur la 1ère colonne (ville), le contenu nécessite du retraitement, ils apparaissent de cette forme:
1.Marseille toto
2.Marseille titi
3.Paris titito
4.Marseille tototi

Je voudrais répartir la ligne dès que la colonne "Ville" comporte le mot clé PARIS ou MARSEILLE

Le code que j'ai essayé d'adopter selon l'exemple est ceci:
Code:

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 29 30 31 32 33 Dim rngList As Range, rngData As Range, rngCriteria As Range, r As Long Set rngData = episheet.Range("A1").CurrentRegion With Feuil1 Set rngList = .Range("A10"): Set rngCriteria = .Range("C10:C11") End With ' Etape 1 - Création d'une liste unique basée sur la colonne 1 With rngData .Resize(, 1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngList, Unique:=True End With ' Etape 2 - Boucle sur la liste avec placement du critère ' Création nouvelle feuille ' Exportation vers nouvelle feuille ' Déplacement de cette nouvelle feuille vers un nouveau classeur For r = 1 To rngList.CurrentRegion.Rows.Count - 1 rngCriteria.Cells(2, 1) = Mid(rngList.Offset(r), 3, Len(rngList.Offset(r)) - 4) ' Insère le critère ' 2.1 - Création d'une feuille Sheets.Add before:=Sheets(1): 'Sheets(1).Name = rngList.Offset(r) ' 2.2 - Exportation vers nlle feuille suivant critère With rngData .AdvancedFilter xlFilterCopy, rngCriteria, Mid(Sheets(1).Range("A1"), 3, Len(Sheets(1).Range("A1")) - 4) End With ' 2.3 - Déplacement de la feuille cers un nouveau classeur Sheets(1).Move ' ' Ici code pour sauver classeur, Envoyer par email etc... ' Next End Sub
Ce code ne fonctionne pas au niveau du
Code:

1 2 3 4 With rngData .AdvancedFilter xlFilterCopy, rngCriteria, Mid(Sheets(1).Range("A1"), 3, Len(Sheets(1).Range("A1")) - 4) End With
Pourrait quelqu'un me corriger un peu plus explicitement svp

Merci beaucoup!!:cry:

Problème de condition

Bonjour le forum,

Je me permets de vous solliciter de nouveau car mon problème n'a toujours pas été résolu....

Je réexplique ma casse-tete: Je possède un fichier que je voudrais répartir les lignes en fonction de la modalité sur la colonne "ville"( soit paris, soit marseille), les deux fichiers paris et marseille sont prédéfinis et ont des lignes d'historiques, donc je ne veux pas créer de nouveaux fichiers.

Code:

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
29
30
31
32
33
 
Workbooks.Open ("...xls"), local:=True
Set vierge_Paris = Workbooks("....xls")
Set Anc_Paris = vierge_Paris.Worksheets("ANCIENNE OFFRE")
Set vierge_Marseille = Workbooks("....xls")
Set Anc_Marseille = vierge_Marseille.Worksheets("ANCIENNE OFFRE")
 
    origine.Activate
    NbligneTot = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To NbligneTot
        If Mid(Range("A" & i), 3, Len(Range("A" & i)) - 4) = "Marseille" Then
        Range("A" & i & ":W" & i).Select
        Selection.Copy
        Nov_Marseille.Activate
        debut = Range("B" & Rows.Count).End(xlUp).Row + 1
        Range("B" & debut).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
 
        ElseIf Mid(Range("A" & i), 3, Len(Range("A" & i)) - 4) = "PARIS" Then
        Range("A" & i & ":W" & i).Select
        Selection.Copy
        Nov_Paris.Activate
        debut = Range("B" & Rows.Count).End(xlUp).Row + 1
        Range("B" & debut).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    End If
Next
 
End Sub

Le problème existe au niveau de la boucle For et la condition IF... quelqu'un pourrait me corriger svp:cry::cry::cry:

Merci beaucoup!!!

02/01/2014, 11h36
Marc-L

Et dire que c'est bien plus simple via les deux pistes déjà proposées pourtant bien adaptées à ce cas … :no: