Créer n fichiers suivant le contenu d'une colonne

Bonjour,

J'ai un tableau avec des informations diverses dont 1 colonne qui concerne la région géographique. Je voudrais pouvoir créer 1 fichier excel par région, chaque fichier ne contenant que les données qui concerne cette région.

Je ne sais pas trop comment procéder. Je pense à une macro VBA mais je n'y arrive pas. Avez-vous une idée ?

Merci de votre aide.

ci-joint 1 fichier exemple simplifié.

Bonjour xosan13, le forum,

Voici une macro de l'excellent Thauthème , adaptée à ton fichier.

Cordialement,

Bonjour,

Merci xorsankukai.

Je viens de récupérer le fichier. En cliquant sur le bouton, j'obtiens 1 onglet par région géographique. Je vais essayer de la modifier pour obtenir un fichier excel par région. En tout cas, merci beaucoup pour cette macro qui me montre comment faire la partie la plus difficile pour moi .

Re-bonjour,

Je vous tiens au courant de mes avancées

J'ai créé une nouvelle macro basée sur celle Thauthème (indiquée par xorsankukai) pour sauver chaque partie filtrée dans un fichier excel au lieu d'un onglet.

Cela fonctionne bien, les fichiers sont créés sauf quand j'ouvre un des fichiers créé, j'ai le message suivant

Je clique sur Oui et le contenu du fichier s'affiche correctement.

Voici les commandes que j'ai utilisées pour créer le fichier :

    Set newWk = Workbooks.Add
    titre.Copy newWk.Sheets(1).Range("A1"): newWk.Sheets(1).Range("A1:D1").Font.Bold = True '...................... copie les titres en gras vers A1 (nouveau fichier)
    pl.Offset(0, -3).Resize(pl.Rows.Count, 4).SpecialCells(xlCellTypeVisible).Copy newWk.Sheets(1).Range("A2") '..  copie les lignes filtrées vers A2 (nouveau fichier)
    Application.DisplayAlerts = False
    newWk.SaveAs (ThisWorkbook.Path & "\" & CStr(tp(i)) & ".xls")
    newWk.Close
    Application.DisplayAlerts = True

Avez-vous une idée sur le pourquoi de ce message ?

Voici le fichier exemple que j'ai modifié

En relisant mon post, je viens de comprendre ......

Il faut mettre ".xlsx" :

newWk.SaveAs (ThisWorkbook.Path & "\" & CStr(tp(i)) & ".xlsx")

Et là tout fonctionne bien.