Couper un fichier Excel

Bonjour voici mon pb, j'espère que vous pourrez m'aider

Voila j'ai un ficheir Excel avec de très nombreuses lignes (1 seule colonne)

Je souhaiterais pouvoir couper ce fichier excel en X fichiers excel différents (renommer automatiquement) de Y lignes.

Quelqu'un aurait il une idée.

C'est mon 1er post alors merci d'avance à tous pour votre aide

Ronan

Bonjour rl64 ,

Donne-nous un bout de fichier stp

Regarde en haut à droite Joindre un fichier .

Cdlt,

.

Il semble y avoir une réponse possible sur un autre forum

mais j'avoue que je ne comprend pas la manip

Re, rl64 ,

J’ai déjà vus quelque chose d’approchant sur un autre fil, je te tiens au courant.

Cdlt,

Merci beaucoup c'est très gentil à vous

Merci beaucoup pour ta réponse et le temps que tu y as passé.

Je vais être un peu chiant mais en fait ça n'est pas vraiment ce que j'attends.

Je m'explique.

Je souhaiterai d'une part juste indiqué le nombre de ligne souhaité (mon fichier d'exemple eétait assez simple car seulement une centaine de ligne, mais avec ta méthode c'est bcp plus compliqué et long lorsqu'il y a plusieurs milliers de ligne)

et d'autres part je souhaiterai que mon fichier soit découper en créant ed'autres fichiers excel (et non pas des pages au sein même d'1 seul fichier excel)

Re,

Ok, excuse-moi, j'avais mal lu ton post.

Cela va m’être plus compliqué de t’aider, mais je vais essayer.

Si l’un des honorables membres a la solution, qu’il n’hésite pas.

Cdlt,

merci c'est très gentil

liste

Bonsoir,

au vu de ton fichier, j'ai pensé à un truc.....

Tu as des adresses mails.....

Avec ce que j'ai concocté, tu as autant de fichiers que d'initiales....

Le code te permet d'enregistrer dans chaque fichier ( "Noms A", "Noms B"..........), tous les contacts commençant par ces lettres....

Pour bien utiliser mon fichier exemple, enregistre-le dans un répertoire spécifique, ce sera plus facile.....

Le code :

Sub balayage()
Dim Cel As Range
Dim Initiales As Object
Dim It
Dim LePath As String, LeNom As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveSheet
    If InStr(.Range("A1"), "@") > 0 Then
        .Rows("1:1").Insert Shift:=xlDown
    End If
    If .Range("A1").Value <> "Adresses Mail" Then
        .Range("A1").Value = "Adresses Mail"
    End If
    Set Initiales = CreateObject("Scripting.Dictionary")
    .Range("A1:A" & .[A65000].End(xlUp).Row).Name = "base"
    .Range("A2:A" & .[A65000].End(xlUp).Row).Name = "base2"
    For Each Cel In .Range("base2")
        If Not Initiales.Exists(UCase(Left(Cel, 1))) Then _
            Initiales.Add UCase(Left(Cel, 1)), UCase(Left(Cel, 1))
    Next Cel
    LePath = ActiveWorkbook.Path & "\"
    For Each It In Initiales.Items
        LeNom = "Noms " & It & ".xls"
        Sheets.Add
        Range("A1").Value = .Range("A1").Value
        Range("B2").FormulaR1C1 = "=UPPER(LEFT(" & .Name & "!RC1,1))=""" & It & """"
        .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
            "B1:B2"), CopyToRange:=Range("A1"), Unique:=False
        Cells.Columns.AutoFit
        [B2].ClearContents
        With ActiveSheet
            .Name = LeNom
            .Move
        End With
        With ActiveWorkbook
            .SaveAs Filename:=LePath & LeNom
            .Close
        End With
    Next It
End With
End Sub

Le fichier exemple :

https://www.excel-pratique.com/~files/doc/adresses.zip

Edit, et j'oubliais......

Avec ton fichier exemple, sur mon PC, le code se déroule en un peu moins de 7 secondes....

Sur ton fichier réel, s'il comporte plusieurs milliers de lignes, ce pourrait être un tout petit peu plus long......

Bon courage

Merci beaucoup, je vais essayé (lundi) et je te tiens au courant.

Bon week end

C'est effectivement un super code!

Est ce qu'il serait possible de l'affiner pour que chaque nouveau fichier ne contienne que 99 ligne?

Rechercher des sujets similaires à "couper fichier"