Création de fichier + Tri

[JeanMikael]

Bonjour le forum

Voilà dans un fichier j'ai une colonne avec des chiffre 3004, 3005, 3006, 3007
ce que j'aimerai c'est crée un fichier pour chaque chiffre de la colonne E soit 4 fichiers, dans ces fichiers j'aimerai que toutes les données relatives par exemple au chiffre 3004 soit dans ce fichier donc une copie de la cellule entière a chaque fois que le programme rencontre 3004 et un collé dans le nouveau fichié crée et intitulé 3004, et ainsi de suite pour les autres chiffres, j'espère avoir été clair.

Personne pour m'aider ?

Bonne journée

Cordialement,
Jean-Mikaël

 

[Catrice]

Re : Création de fichier + Tri

Bonjour,

Tu devrais fournir une petite maquette. Fichier de départ et ce que tu veux obtenir ...

 

[smotty]

Re : Création de fichier + Tri

Bonjour Jean-Mikael,

Je ne suis pas sûr d'avoir compris ce que tu souhaitais enregistrer dans chaque fichier donc je suis parti sur le principe de copier les données de toute la ligne.
Voici donc un code qui fonctionne.

Sub essai()
Application.ScreenUpdating = False
For x = 1 To [E65000].End(xlUp).Row
nomfichier = CStr(Cells(x, 5).Value) & ".xls"
Set rg = Rows(x)
Workbooks.Add
Application.ActiveSheet.Rows(1).Value = rg.Value
With Application.ActiveWorkbook
.Close savechanges:=True, Filename:=nomfichier
End With
Next x
Application.ScreenUpdating = True
End Sub

Cordialement

 

[smotty]

Re : Création de fichier + Tri

Re

Je viens de comprendre ce que tu souhaite faire exactement, donc le code que je t'ai envoyé ne fera pas ce que tu souhaite. Je t'envoie la rectif dès que possible

Cordialement

 

[smotty]

Re : Création de fichier + Tri

Encore moi,

Cette fois c'est la bonne. Ce code fonctionne, il teste si le fichier existe. Si oui alors ajoute les données sinon en crée un et y ajoute les données.

En espérant que ça te conviendra

Sub essai()
Dim ref As String
Dim NomFichier As String
Dim w As Workbook

Application.ScreenUpdating = False
For x = 1 To [E65000].End(xlUp).Row
On Error Resume Next
ref = CStr(Cells(x, 5).Value)
NomFichier = ref & ".xls"
Set rg = Rows(x)
s = Dir(NomFichier)
If s = "" Then
Workbooks.Add
With Application.ActiveWorkbook.ActiveSheet
l = .[E65000].End(xlUp).Row + 1
.Rows(l).Value = rg.Value
End With
With Application.ActiveWorkbook
.Close savechanges:=True, Filename:=NomFichier
End With
Else
'Err.Clear
Set w = GetObject(NomFichier)
With w.Sheets(1)
l = .[E65000].End(xlUp).Row + 1
.Rows(l).Value = rg.Value
End With
w.Close savechanges:=True
End If
Next x
Application.ScreenUpdating = True
End Sub


Cordialement