Découper les informations d'une colonne

[Salgueiro]

Bonjour
J'ai un listing d'emails de 5000/6000 emails sur une une seule colonne A, j'ai besoin d'effectuer un découpage de cette liste par des fichiers excell séparés d'une colonne avec seulement 200 adresses emails à chaque fois.
Est-ce possible d'automatiser ce travail ?
merci à tous

 

[Staple1600]

Bonjour le fil, le forum

@Salgueiro [Bienvenue sur le forum]
Oui, c'est possible.
Mais avec un fichier exemple et des adresses mail fictives pour faire un test ce serait plus simple de t'aider, non?

En attendant ton fichier, je t'invite également à lire ce récent fil et notamment les propositions de mapomme.
Tu devrais y trouver du code VBA te permettant de faire ce que tu souhaites (moyennant quelques adaptations)

 

[kingfadhel]

Bonjour le fil, le forum

code VBA testé:

Sub Decoupage_mail()
Application.ScreenUpdating = False
Dim i, j, nbr As Integer
'Détection de la dernière ligne
nbr = Range("A1").End(xlDown).Row
j = 0
For i = 1 To nbr Step 200
Range("A" & i & ":A" & i + 199).Copy
j = j + 2
Cells(1, j + 1).PasteSpecial Paste:=xlPasteValues
Next
'Largeure automatique des colonnes
Cells.Select
Cells.EntireColumn.AutoFit
'Suppression de la colonne source
Range("A:A").Delete
Application.ScreenUpdating = True
End Sub

 

[kingfadhel]

Un Fichier Joint

 

[Staple1600]

Bonjour le fil, le forum

@kingfadhel

j'ai besoin d'effectuer un découpage de cette liste par des fichiers excel

J'ai compris qu'il fallait générer N fichiers Excel qui contiennent chacun 200 mels
à partir de la colonne contenant tous les mels dans le classeur actif.

 

[kingfadhel]

Bonjour @Staple1600,
Ce que j'ai compris, qu'il veux les découper par lots de 200 séparés par une colonne.

séparés d'une colonne avec seulement 200 adresses emails à chaque fois.

 

[Staple1600]

Re


Oui, mais dans un classeur distinct pour chaque liste de 200 mails.
Comme dans la macro ci-dessous
(code adapté d'une macro sortie de la poussière de mes archives)

Sub Eclater_Feuille2NWkb()
Dim Plage As Range, Lig As Range, strPath$, Feuille As Worksheet
On Error Resume Next
strPath = ThisWorkbook.Path & "\"
Set Plage = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
Set Feuille = Plage.Parent: Set Lig = Plage.Rows(1)
Application.ScreenUpdating = False
For i = 1 To Plage.Rows.Count Step 200
    NBLig = 200
    If (Plage.Rows.Count - Lig.Row + 1) < 200 Then NBLig = Plage.Rows.Count - Lig.Row + 1
    Lig.Resize(NBLig).Copy
    Workbooks.Add xlWBATWorksheet
        With ActiveWorkbook
            .Sheets(1).Range("A1").PasteSpecial
            .SaveAs strPath & "emails_" & i & ".xls"
            .Close True
        End With
    Set Lig = Lig.Offset(200)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Attendons le retour du demandeur (et éventuellement de son fichier exemple) pour savoir quelle la bonne interprétation de sa question

 

[Salgueiro]

Bonjour
merci pour votre participation.Effectivement ce que je souhaite et qu'à partir d'un fichier initial de 5000emails je le découpe en autant de fichiers avec par colonne 200 emails maximun (soit 5000/200=25 fichiers excells.

 

[Staple1600]

Bonsoir le fil, le forum

@Salgueiro
C'est ce que fait ma macro du message#7, non ?
Tu l'as testée?

 

[Salgueiro]

Bonsoir
Après phase de test celui fonctionne, juste que lorsque on obtient les fichiers et que l'on souhaite les ouvrir par click direct un message d'erreur apparait :" le format et l'extension du fichier ne correspond pas". Néanmoins celui-ci reste valide si on l'ouvre après avec excell 2013. Un moyen de corriger ?
cdt

 

[Staple1600]

Bonsoir le fil, le forum

Remplace cette ligne
SaveAs strPath & "emails_" & i & ".xls"
par
SaveAs strPath & "emails_" & i & ".xlsx"

 

[Salgueiro]

Merci à toi cela marche au top