Simplifier Macro avec Liste pour "si texte contient"

[Michel_ja]

Bonjour à tous,
j'ai écrit, tant bien que mal ce code pour une macro qui, en fonction du texte (ici des noms de pays qui m'intéressent) contenu dans la cellule me coupe et colle cette cellule à une endroit précis sur une autre feuille. Au départ je n'avait que 3 ou 4 noms de pays mais là j'en ai près d'une dizaine ...
J'aimerais savoir si on peut simplifier ce code en créant une liste, en renvoyant à une plage où il y aurait tous les pays qui m'intéressent.

Merci à vous !


Sub Auto_ArchivesNew()
Dim i As Integer 'i=C
Dim j As Integer 'j=L

Dim LigneFinNewsCountries As Integer
Dim LigneFinArchivesAuto As Integer

LigneFinNewsCountries = Range("A65536").End(xlUp).Row 'Feuille où je reçois les infos classées par pays
LigneFinArchivesAuto = Sheets("ArchivesAuto").Range("A65536").End(xlUp).Row + 1 'Feuille où je classe les infos triées


Sheets("NewsCountries").Select

i = 1
j = 10

For j = 10 To LigneFinNewsCountries

Sheets("NewsCountries").Select
Cells(j, i).Activate



If ActiveCell.Text Like "*France*Automotive*" Then
ActiveCell.Select
Selection.Cut
Sheets("ArchivesAuto").Select
Cells(LigneFinArchivesAuto, 1).Select
ActiveSheet.Paste
Cells(LigneFinArchivesAuto, 3).Value = "France"

Sheets("NewsCountries").Select 'infos adjacentes à la cellule que je rappatrie aussi dans la nouvelle feuille
Cells(j, i).Activate
ActiveCell.Offset(1, 0).Select
Selection.Cut
Sheets("ArchivesAuto").Select
Cells(LigneFinArchivesAuto, 4).Select
ActiveSheet.Paste

Sheets("NewsCountries").Select
Cells(j, i).Activate
ActiveCell.Offset(2, 0).Select
Selection.Cut
Sheets("ArchivesAuto").Select
Cells(LigneFinArchivesAuto, 2).Select
ActiveSheet.Paste
LigneFinArchivesAuto = LigneFinArchivesAuto + 1



ElseIf ActiveCell.Text Like "*Italy Automotive*" Then
ActiveCell.Select
Selection.Cut
Sheets("ArchivesAuto").Select
Cells(LigneFinArchivesAuto, 1).Select
ActiveSheet.Paste
Cells(LigneFinArchivesAuto, 3).Value = "Italy"

Sheets("NewsCountries").Select
Cells(j, i).Activate
ActiveCell.Offset(1, 0).Select
Selection.Cut
Sheets("ArchivesAuto").Select
Cells(LigneFinArchivesAuto, 4).Select
ActiveSheet.Paste

Sheets("NewsCountries").Select
Cells(j, i).Activate
ActiveCell.Offset(2, 0).Select
Selection.Cut
Sheets("ArchivesAuto").Select
Cells(LigneFinArchivesAuto, 2).Select
ActiveSheet.Paste
LigneFinArchivesAuto = LigneFinArchivesAuto + 1


ElseIf ActiveCell.Text = "" Then
j = j

End If

Next j

End Sub

 

[frangy]

Re : Simplifier Macro avec Liste pour "si texte contient"

Bonjour,

J’ai ajouté la feuille "Pays" dans laquelle sont indiqués les pays à rechercher.
Pour chaque pays de la liste, le programme effectue la recherche du texte partiel "pays*automotive" dans la feuille "NewsCountries", copie les données dans la feuille "ArchivesAuto" puis efface ces données dans "NewsCountries".

A+

 

[Michel_ja]

Re : Simplifier Macro avec Liste pour "si texte contient"

Merci Merci Frangy ! Excellent, ça marche et ma liste est maintenant extensible à volonté !!
Je note qu'il faut que je m'améliore dans l'utilisation des ranges !!! C'est aussi la première fois que je vois le terme "Wend" pour finir la boucle avec While.
Bref, ce forum m'ouvre l'appétit à la connaissance de VB.