Macro de création de fichier qui oublie une ligne de titre

[LPandre]

Bonjour, j'ai récupéré du code qui me permet de créer dans un répertoire de mon disque C, autant de fichiers qu'il y a de valeurs différents en colonne A.
ça, ça marche.
Mais pourquoi la ligne 3 des jours datés n'est pas reprise dans chacun des fichiers ?
Fichier de base en pj.
Code vba utilisé (c'est de l'adaptation, vu que mon niveau ne me permet pas de tout piger) :

Sub Macro12()
Dim nwbk As Workbook
Dim dl&, dc%, i&, iDeb&, iFn&
Dim ws As Worksheet, R As Range, iCl%
On Error Resume Next
Application.DisplayAlerts = False
Sheets("edit97").Select
With ActiveSheet
Set R = .Range([A4], .[A65536].End(xlUp))
On Error GoTo 0
If R Is Nothing Then Exit Sub
iCl = R.Column
Application.ScreenUpdating = False
Application.EnableEvents = False
dl = .Cells(Rows.Count, "A").End(xlUp).Row
dc = .Cells(4, Columns.Count).End(xlToLeft).Column
.Range(.Cells(4, 1), .Cells(dl, dc)).Sort Key1:=.Cells(4, iCl), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iDeb = 4
For i = 4 To dl
If .Cells(i, iCl).Value <> .Cells(i + 1, iCl).Value Then
iFn = i
Workbooks.Add xlWBATWorksheet
Set nwbk = ActiveWorkbook
Set ws = nwbk.Sheets(1)
On Error Resume Next
ws.Name = .Cells(iDeb, iCl).Text
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, dc)).Value = .Range(.Cells(1, 1), .Cells(1, dc)).Value
.Range(.Cells(iDeb, 1), .Cells(iFn, dc)).Copy ws.Range("A4")
nwbk.SaveAs "C:\Bob_eff\" & ws.Name
nwbk.Close True
iDeb = iFn + 1
End If
Next i
End With
End Sub

***
Grand MERCi d'avance.

 

[Paf]

Bonjour LPandre,

avec ws.Range(Cells(1, 1), Cells(1, dc)).Value = .Range(.Cells(1, 1), .Cells(1, dc)).Value , on copie la première ligne vers le nouveau classeur
avec .Range(.Cells(iDeb, 1), .Cells(iFn, dc)).Copy ws.Range("A4"), on copie à partir de la ligne 4 (iDeb est initialisée à 4 puis réinitialisée à chaque changement de valeur en colonne A donc supérieur à4).

Les lignes 2 et 3 ne sont jamais copiées.

Essayer en modifiant ainsi:
ws.Range(Cells(1, 1), Cells(3, dc)).Value = .Range(.Cells(1, 1), .Cells(3, dc)).Value

A+

 

[LPandre]

MERCI !
C'est le problème de récupérer des bout de codes sans vraiment savoir ce qui se passe. Mais... les membres du forum sont là !

De nouveau MERCI !