Boucle pour sélectionner les données d'une colonne une par une Fermé

Question

Bonjour,

J'ai un fichier avec des données que je dois trier par pays (13 pays au total).
Il y a 4 onglets ou je dois sélectionner un pays, copier les données et les coller dans un autre fichier. Ensuite, je dé-filtre tout et je dois recommencer pour les 12 autres pays.

Est-il possible ce créer une boucle qui passerait sur les 4 onglets un par un pour chaque pays ?
Dans ce cas, il faut définir la liste de pays sur laquelle le code se base?

Je précise que je débute en vba. 
N'hésitez pas si le problème n'est pas suffisamment clairement posé.

Merci d'avance.

Julien

via55 · Answer

Bonjour

Oui tu peux faire dans une feuille appelée DATA de A1 à A13 la liste des pays et de B1à B4 la liste des noms des 4 onglets

Après ta macro va boucler sur les pays puis sur les onglets

For n=1 to 13
nompays=sheets("DATA").Range("A" & n)
For j=1 to 4
nomonglet=sheets("DATA").Range("B" & n)
sheets(nomonglet).Select  'Selectionne un onglet

'ici tes instructions de recherche et de copie des données
'...................

next j  'onglet suivant
next n 'pays suivant

Cdlmnt

malleinj · Answer

Bonjour,

tout d'abord merci pour ton aide.

Voici ce que j'ai écrit :

Sub FiltrerPays()

For n = 1 To 13
nompays = Sheets("DATA").Range("A" & n)
For j = 1 To 4
nomonglet = Sheets("DATA").Range("B" & n)
Sheets(nomonglet).Select  'Selectionne un onglet

Selection.AutoFilter Field:=19, Criteria1:=nompays, Operator:=xlAnd

Next j  'onglet suivant

Next n 'pays suivant

End Sub

Ca fonctionne pour le premier pays en passant par les 4 onglets mais après ca ne marche plus à partir de "Sheets(nomonglet).Select  'Selectionne un onglet".
Faut-il défiltrer a chaque fois?

Après il faut que je modifie mon code car une fois que les 4 onglets sont filtrés sur un pays, je veux enregister une copie du fichier sous le nom du pays dans un dossier qui est le même pour tous les pays en mettant un truc du genre : "ThisWorkbook.SaveCopyAs Filename:=Dossier & Nom & " " & strDate & ".xls""

Merci beaucoup

Julien

malleinj · Answer

Voilà ou j'en suis :

Sub FiltrerPays()

For i = 1 To 13
nompays = Sheets("DATA").Range("A" & i)
For j = 1 To 4
nomonglet = Sheets("DATA").Range("B" & j)
Sheets(nomonglet).Select  'Selectionne un onglet

Selection.AutoFilter Field:=19, Criteria1:=nompays, Operator:=xlAnd

Next j  'onglet suivant

ThisWorkbook.SaveCopyAs Filename:=Sheets("DATA").Range("A" & i).Value & ".xls"

Next i 'pays suivant

End Sub


J'arrive a créer un fichier pour chaque pays avec le nom du pays. Le problème est que j'ai sur chaque fichier de pays les données de tous les pays (elle sont juste cachées). Il faudrait su'a chaque fichier crée, je puisse supprimer les données des autres fichiers et n'avoir que les données du pays sur le fichier du pays...
Est-ce possible?

Merci beaucoup de votre aide.

Julien

via55 · Answer

Bonjour

Dans ce cas au lieu de filtrer tu devrais plutôt recopier toutes les données concernant le pays sur une nouvelle feuille puis ensuite enregistrer cette feuille

Pour cela tu crées une feuille que tu appelles Données
Tu lui mets à la même place que les autres feuilles les titres des colonnes en ligne 1

Sub FiltrerPays()
Dim ligne as long

For i = 1 To 13
nompays = Sheets("DATA").Range("A" & i)
' selectionne et efface Données
sheets("Données").select
sheets("Données").Range("A2:F100").Select 'modifier la plage en fonction du nombres de colonnes et de lignes susceptiples d'etre remplies
    Selection.ClearContents
'variable n° de ligne où copier
x=1
For j = 1 To 4
nomonglet = Sheets("DATA").Range("B" & j)
' derniere ligne remplie de la feuille  nomonglet
Ligne =Sheets(nomonglet). Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
' boucle depuis la ligne 2 jusqu'à la dernière
For n=2 to Ligne ' à modifier si les données ne commencent pas en ligne 2
'Vérifie que le nom de pays est bien le bon en colonne A
if sheets(nomonglet).range("A" & n) = nompays then ' A adapter si le nom est dans une autre colonne
' si c'est le cas on incremente la variable ligne et on copie dans Données
x=x+1
 Sheets(nomonglet).Select
    Rows(n & ":" & n).Select
    Selection.Copy
    Sheets("Données").Select
    Range("A" & x ).Select 
    ActiveSheet.Paste
end if
Next n

Next j  'onglet suivant

ActiveSheet.Copy
ActiveWorkbook.SaveCopyAs Filename:=Sheets("DATA").Range("A" & i).Value & ".xls"

Next i 'pays suivant

end sub


Cdlmnt
 
"L'imagination est plus importante que le savoir."    A. Einstein

malleinj · Answer

Rebonjour,

ceci me semble compliqué car sur les 4 onglets, il y a des données de tous les pays.
A la fin, mon fichier par pays doit contenir 4 onglets.

J'imaginais plutôt pouvoir faire la première partie et coller les données sur un autre fichier après la boucle j.

Est-ce possible?

Merci beaucoup

Julien

malleinj · Answer

Ok merci beaucoup.

Pour info, voici ce que j'ai crée du coup.
C'est un peu simplet mais ca marche. 
La seule opération manuelle que je dois faire est de mettre le nom du pays quand il me demande d'enregistrer sous.
Est-il possible qu'il trouve le nom du pays en utilisant la feuille DATA de mon fichier de départ pour enregistrer automatiquement?

Sub FiltrerPays()

For i = 1 To 13
nompays = Sheets("DATA").Range("A" & i)
For j = 1 To 4
nomonglet = Sheets("DATA").Range("B" & j)
Sheets(nomonglet).Select  'Selectionne un onglet

Selection.AutoFilter Field:=19, Criteria1:=nompays, Operator:=xlAnd

Next j  'onglet suivant

Workbooks.Open Filename:= _
        "C:\Users\jmallein\Travaux fichiers excel\Order by country.xlsx"
  
    Windows("Matrice to receive.xlsm").Activate
    Sheets("Directe").Select
    Range("A5:M5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Windows("Order by country.xlsx").Activate
    Sheets("Directe").Select
    Range("B1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Matrice to receive.xlsm").Activate
    Sheets("Centrale").Select
    Range("A5:T5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Windows("Order by country.xlsx").Activate
    Sheets("Centrale").Select
    Range("B1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Matrice to receive.xlsm").Activate
    Sheets("Tactical").Select
    Range("A5:T5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Windows("Order by country.xlsx").Activate
    Sheets("Tactical").Select
    Range("B1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Matrice to receive.xlsm").Activate
    Sheets("Interstore").Select
    Range("A5:J5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Windows("Order by country.xlsx").Activate
    Sheets("Interstore").Select
    Range("B1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Récapitulatif").Select
    ActiveWorkbook.RefreshAll
    
    Application.Dialogs(xlDialogSaveAs).Show
    ActiveWindow.Close

Next i 'pays suivant

    Sheets("Directe").Select
    ActiveSheet.Range("A:T").AutoFilter Field:=19
    Sheets("Centrale").Select
    ActiveSheet.Range("A:T").AutoFilter Field:=19
    Sheets("Tactical").Select
    ActiveSheet.Range("A:T").AutoFilter Field:=19
    Sheets("Interstore").Select
    ActiveSheet.Range("A:T").AutoFilter Field:=19

End Sub

Boucle pour sélectionner les données d'une colonne une par une

6 réponses

Discussions similaires

Newsletters