Scinder un fichier Excel en plusieurs onglets

Bonjour,

j'ai une feuille excel que j'exporte chaque trimestre qui contient dans un seul et même onglet (Agence) plusieurs informations que je dois répartir sur plusieurs onglets.

Je dois répartir sur chaque onglet, les informations de chaque agence

Soit pour l'exemple joint :

Prendre les informations de la ligne 4 à 28 et les copier dans un onglet différent si possible en nommant l'onglet comme la cellule A4 (ex : 0820) seulement avec les chiffres.

et faire la même chose pour l'ensemble des agences se trouvant à la suite.

Par contre le nombre de ligne n'est pas identique à chaque agence.

Il me faudrait un truc pour lui dire de copier des qu'il trouve l'information de l'agence.

J'ai trouvé des macros sur le site, mais je n'arrive pas à les adapter à mon fichier.

Très débutante sur le sujet.

Merci de votre aide

387a-scinder.zip (25.70 Ko)

Exécute la macro repartir

Fait sans grand raffinement, à intégrer ensuite dans ton projet où il y a déjà des macros...

Attention possible conflit entre fonction


Sub repartir()
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheets("Agence")

depuis = 0
jusque = 0
flag = False
num_agence = ""

For i = 1 To Range("A65000").End(xlUp).Row
    flag = False
    If Cells(i, 1) Like "PLATEFORME CLIENTS*" Then
        jusque = i - 1
        flag = True
    End If
    If Cells(i, 1) Like "Agence*" Then
        depuis = i
        flag = False
    End If
    If flag And depuis <> 0 Then
        'MsgBox "de " & depuis & " à " & jusque & " - Agence " & Mid(Cells(depuis, 1), 10, 4)
        num_agence = Mid(Cells(depuis, 1), 10, 4)
        ' creation de l'onglet
        If Not FeuilleExiste(ThisWorkbook, num_agence) Then
            Sheets.Add
            ActiveSheet.Name = num_agence
            Set ws2 = ActiveSheet
        Else
            Sheets(num_agence).Select
            Cells.Clear
            Set ws2 = ActiveSheet
        End If
        ws1.Select
        Rows(depuis & ":" & jusque).Select
        Selection.Copy
        ws2.Select
        Range("A1").Select
        ActiveSheet.Paste
        ws1.Select
    End If
Next i

End Sub

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
    On Error Resume Next
    FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function
412a-scinder.zip (19.47 Ko)

Un grand merci.

Ca fonctionne super!!!

Quel gain de temps.

@+

PS : j'aurais sans doute des trucs à faire à l'avenir

On est là pour çà

Rechercher des sujets similaires à "scinder fichier onglets"