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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

LPandre

XLDnaute Impliqué
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.
 

Pièces jointes

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+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
235
Réponses
5
Affichages
232
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Retour