a l aide !!! casse tete découpe + entete de 6 lignes

[jv44]

Bonjour à toutes et a tous !!!

voila j ai un fichier avec une entete (en jaune) allant de la ligne 1 à 6 et le fichier commence a la ligne 7.

J'ai déja une maccro me permettant de creer plusieur fichiers selon le nombre de lignes souhaitées...

le problèmes est le suivant : je souhaiterais qu il remete sur chaque fichier l'entête du fichier original !

merci a tout les exceliens qui parviendrons a resoudre mon soucis !!

 

[jv44]

Re : a l aide !!! casse tete découpe + entete de 6 lignes

personne ?

 

[kjin]

Re : a l aide !!! casse tete découpe + entete de 6 lignes

Bonjour,
Nouvelle mouture

Sub Decoupe()
Dim d As Range, r As Range, pfile$, x#, j#, ws As Worksheet
nb = InputBox("Combien de lignes faut-il créer ?", "DECOUPAGE FICHIER")
If IsEmpty(nb) Or Not IsNumeric(nb) Then Exit Sub
Set d = ActiveSheet.UsedRange
tablo1 = d.Resize(6)
pfile = ActiveWorkbook.Path
x = d.Rows.Count
j = 1
Application.ScreenUpdating = False
For i = 6 To x Step Int(nb)
    tablo2 = d.Offset(i).Resize(Int(nb)).Value
    Set ws = Sheets.Add
    With ws
        .Cells(1, 1).Resize(6, UBound(tablo1, 2)) = tablo1
        .Cells(7, 1).Resize(UBound(tablo2, 1), UBound(tablo2, 2)) = tablo2
        Erase tablo2
        .Copy
        Application.DisplayAlerts = False 'attention: écrase les fichiers existants
        With ActiveWorkbook
            .SaveAs pfile & "\import rejets de prélèvements" & j & " (Dec" & nb & ")" & ".xls"
            .Close True
        End With
        .Delete
        Application.DisplayAlerts = True
    End With
    j = j + 1
Next
Application.ScreenUpdating = True
End Sub

A+
kjin

 

[jv44]

Re : a l aide !!! casse tete découpe + entete de 6 lignes

olalala c est géniale merci beaucoup beaucoup beaucoup !!!!