Bonjour =E0 tous,
Merci =E0 ceux qui vont se pencher ... sans tomber sur mon cas.
J'ai un fichier avec des data par agences, le code de l'agence est en
colonne A, le libell=E9 en B
les donn=E9es vont de E =E0 P. Le nombre de lignes par agence est variable
et je ne connais pas =E0 l'avance le nombre d'agences.
L'objectif est de g=E9n=E9rer un fichier par agence pour le rendre
disponible sur un serveur pour chaque agence \\serveur\cheminsurserveur
\XX o=F9 XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais
automatiser cel=E0.
Cerise sur le gateau, je souhaiterai avoir dans l'ent=EAte de l'=E9dition
le code et le libell=E9 de l'agence.
Aujourd'hui dans une macro je met un code agence dans une zone et je
lance une autre macro
qui filtre sur ce code, qui copie les donn=E9es dans un autre fichier et
enregistre sur le serveur dans le bon r=E9pertoire.
Et l'op=E9ration se r=E9p=E8te autant de fois que je connais les agences. A
chaque cr=E9ation je vais modifier ma macro... au secours.
De plus je conserve ma colonne A et B puisque je ne sais pas comment
ajouter le code et le libell=E9 de l'agence dans l'ent=EAte du tableau
g=E9n=E9r=E9, ce qui me fait perdre une quarantaine de caract=E8res dans la
largeur de l'=E9tat.
Si l'un des Dieux de ce forum (les informaticiens =E9taient consid=E9r=E9s
comme tels il y a une vingtaine d'ann=E9es) peut me guider vers une
solution pratique je l'en remercie par avance.
L'urgent est fait, l'impossible est en cours, pour les mirables ...
pr=E9voir un d=E9lais.
A ) Tu dis avoir développé une macro...jusqu'ici, tu sembles la garder pour toi !
B ) À chaque fois que tu fais rouler la macro, que doit-il se passer pour les fichiers qui ont déjà été créés ? 1. On recrée tous les fichiers sans exception avec les nouvelles données et on écrase les fichiers déjà existants ? 2. Tu veux seulement créer les fichiers inexistants sans toucher au fichier déjà créé ? 3. Autre à définir...
C ) Lors de la création des fichiers, tu veux y copier quoi ? Les colonnes A, B, et les données des colonnes E à P SEULEMENT ? Quelle disposition doivent avoir ces données dans le nouveau fichier? De A1 à Mx sans colonne vide ?
D ) C'est quoi pour toi : "l'entête de l'édition" ? La barre de titre de l'application lorsque le fichier est ouvert ? Autre chose ?
E ) Quel nom doit avoir la feuille dans chacun des fichiers créés ?
MichD ------------------------------------------ "kristofb" a écrit dans le message de groupe de discussion :
Bonjour à tous, Merci à ceux qui vont se pencher ... sans tomber sur mon cas.
J'ai un fichier avec des data par agences, le code de l'agence est en colonne A, le libellé en B les données vont de E à P. Le nombre de lignes par agence est variable et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre disponible sur un serveur pour chaque agence serveurcheminsurserveur XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais automatiser celà. Cerise sur le gateau, je souhaiterai avoir dans l'entête de l'édition le code et le libellé de l'agence.
Aujourd'hui dans une macro je met un code agence dans une zone et je lance une autre macro qui filtre sur ce code, qui copie les données dans un autre fichier et enregistre sur le serveur dans le bon répertoire. Et l'opération se répète autant de fois que je connais les agences. A chaque création je vais modifier ma macro... au secours.
De plus je conserve ma colonne A et B puisque je ne sais pas comment ajouter le code et le libellé de l'agence dans l'entête du tableau généré, ce qui me fait perdre une quarantaine de caractères dans la largeur de l'état.
Si l'un des Dieux de ce forum (les informaticiens étaient considérés comme tels il y a une vingtaine d'années) peut me guider vers une solution pratique je l'en remercie par avance.
L'urgent est fait, l'impossible est en cours, pour les mirables ... prévoir un délais.
Bonjour,
A )
Tu dis avoir développé une macro...jusqu'ici, tu sembles la garder pour toi !
B ) À chaque fois que tu fais rouler la macro, que doit-il se passer pour les fichiers qui ont déjà été créés ?
1. On recrée tous les fichiers sans exception avec les nouvelles données et on écrase les fichiers déjà existants ?
2. Tu veux seulement créer les fichiers inexistants sans toucher au fichier déjà créé ?
3. Autre à définir...
C ) Lors de la création des fichiers, tu veux y copier quoi ? Les colonnes A, B, et les données des colonnes E à P SEULEMENT
?
Quelle disposition doivent avoir ces données dans le nouveau fichier? De A1 à Mx sans colonne vide ?
D ) C'est quoi pour toi : "l'entête de l'édition" ? La barre de titre de l'application lorsque le fichier est ouvert ? Autre
chose ?
E ) Quel nom doit avoir la feuille dans chacun des fichiers créés ?
MichD
------------------------------------------
"kristofb" a écrit dans le message de groupe de discussion :
7a17fe3a-8147-4907-97d6-b12fa8a5f515@fk25g2000vbb.googlegroups.com...
Bonjour à tous,
Merci à ceux qui vont se pencher ... sans tomber sur mon cas.
J'ai un fichier avec des data par agences, le code de l'agence est en
colonne A, le libellé en B
les données vont de E à P. Le nombre de lignes par agence est variable
et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre
disponible sur un serveur pour chaque agence \serveurcheminsurserveur
XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais
automatiser celà.
Cerise sur le gateau, je souhaiterai avoir dans l'entête de l'édition
le code et le libellé de l'agence.
Aujourd'hui dans une macro je met un code agence dans une zone et je
lance une autre macro
qui filtre sur ce code, qui copie les données dans un autre fichier et
enregistre sur le serveur dans le bon répertoire.
Et l'opération se répète autant de fois que je connais les agences. A
chaque création je vais modifier ma macro... au secours.
De plus je conserve ma colonne A et B puisque je ne sais pas comment
ajouter le code et le libellé de l'agence dans l'entête du tableau
généré, ce qui me fait perdre une quarantaine de caractères dans la
largeur de l'état.
Si l'un des Dieux de ce forum (les informaticiens étaient considérés
comme tels il y a une vingtaine d'années) peut me guider vers une
solution pratique je l'en remercie par avance.
L'urgent est fait, l'impossible est en cours, pour les mirables ...
prévoir un délais.
A ) Tu dis avoir développé une macro...jusqu'ici, tu sembles la garder pour toi !
B ) À chaque fois que tu fais rouler la macro, que doit-il se passer pour les fichiers qui ont déjà été créés ? 1. On recrée tous les fichiers sans exception avec les nouvelles données et on écrase les fichiers déjà existants ? 2. Tu veux seulement créer les fichiers inexistants sans toucher au fichier déjà créé ? 3. Autre à définir...
C ) Lors de la création des fichiers, tu veux y copier quoi ? Les colonnes A, B, et les données des colonnes E à P SEULEMENT ? Quelle disposition doivent avoir ces données dans le nouveau fichier? De A1 à Mx sans colonne vide ?
D ) C'est quoi pour toi : "l'entête de l'édition" ? La barre de titre de l'application lorsque le fichier est ouvert ? Autre chose ?
E ) Quel nom doit avoir la feuille dans chacun des fichiers créés ?
MichD ------------------------------------------ "kristofb" a écrit dans le message de groupe de discussion :
Bonjour à tous, Merci à ceux qui vont se pencher ... sans tomber sur mon cas.
J'ai un fichier avec des data par agences, le code de l'agence est en colonne A, le libellé en B les données vont de E à P. Le nombre de lignes par agence est variable et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre disponible sur un serveur pour chaque agence serveurcheminsurserveur XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais automatiser celà. Cerise sur le gateau, je souhaiterai avoir dans l'entête de l'édition le code et le libellé de l'agence.
Aujourd'hui dans une macro je met un code agence dans une zone et je lance une autre macro qui filtre sur ce code, qui copie les données dans un autre fichier et enregistre sur le serveur dans le bon répertoire. Et l'opération se répète autant de fois que je connais les agences. A chaque création je vais modifier ma macro... au secours.
De plus je conserve ma colonne A et B puisque je ne sais pas comment ajouter le code et le libellé de l'agence dans l'entête du tableau généré, ce qui me fait perdre une quarantaine de caractères dans la largeur de l'état.
Si l'un des Dieux de ce forum (les informaticiens étaient considérés comme tels il y a une vingtaine d'années) peut me guider vers une solution pratique je l'en remercie par avance.
L'urgent est fait, l'impossible est en cours, pour les mirables ... prévoir un délais.
kristofb
MichD, Tout d'abord merci et je te prie de bien vouloir excuser mon manque de précisions.
A) Tu trouveras la macro Macro en fin de message. (il sagit plus d'un enregistrement de macro qu'un développement) B) Les fichiers écraseront les fichiers déjà existant et ils seront créés si inexistant C) Les colonnes A et B ne me serviront que pour le titre de l'état et la rupture par agence, elle deviennent ensuite inutile. D) l'Entête d'édition correspond pour moi à ce que l'on trouve dans mise en page Entête/pied de page//Entête personalisée//Partie central e E) peut importe le nom de la feuille, elle pourrait par exemple avoir le code de l'agence.(pour le moment j'ai laissé feuill1).
Le projet aévolué mais, mon problème reste l'automatisation de la division du fichier en fonction des codes agences présent dans le fichiers. Le fichier d'origine contient les données de toutes les agences, l'objectif est de faire un fichier par agence sans avoir à alimenter "manuellement" les codes agences dans la macro.
Je pensais avoir posté ma réponse hier mais j'ai du me planter elle n'est pas affichée aujourdhui. Encore Merci à toi et à ceux qui me dirigeront vers une solution.
voici le source : 'Déclaration variable zagence pour utilisation inter macro Public zagence As String Sub ipmmat() ' chargement des datas récupérées par ftp Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _ xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _ ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True, Comma:úlse _ , Space:úlse, Other:úlse, FieldInfo:=Array(Array(1, 2), Array(2, 2), _ Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7, 2), Array(8, 2), Array(9, 2), _ Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array( _ 16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 2), Array(21, 2), Array(22, 1)) _ , TrailingMinusNumbers:=True Selection.CurrentRegion.Select Selection.Copy ' ouverture fichier entete Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _ Origin:=xlWindows ' copie data dans fichier d'entete Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse Application.CutCopyMode = False ' mise en forme période achat mm-ssaa Columns("V:V").Select Selection.NumberFormat = "00-0000" Range("A1").Select ' enregistrement fichier complet avec désactivation puis réactivation msgbox Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes- ag.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ' mise en place filtre Range("A1").Select Selection.AutoFilter ' mise en place agence et lancement macro agence ' Dim zagence As String zagence = "01" macro_agence zagence = "02" macro_agence ' Fermeture fichiers ouverts et sortie de l'application Application.DisplayAlerts = False ActiveWindow.Close ActiveWindow.Close Application.Quit End Sub ' macro speciale agence Sub macro_agence() Selection.AutoFilter Field:=3, Criteria1:="=" & zagence Selection.CurrentRegion.Select Selection.Copy Workbooks.Add ActiveSheet.Paste Columns("A:B").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("E:F").Select Selection.Delete Shift:=xlToLeft Columns("H:H").Select Selection.Delete Shift:=xlToLeft Columns("L:Q").Select Selection.Delete Shift:=xlToLeft Range("L1").Formula = "pos" Range("M1").Formula = "Commentaires " Cells.Select Range("A1").Activate Cells.EntireColumn.AutoFit Columns("A:B").Select Selection.ColumnWidth = 0 Range("A1").Select ' mise en forme Edition With ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "&""Arial,Gras""&16INVENTAIRE PARC MATERIEL " _ & Worksheets("Feuil1").Range("A2") & " " & Worksheets("Feuil1").Range("B2") .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.787401575) .RightMargin = Application.InchesToPoints(0.787401575) .TopMargin = Application.InchesToPoints(0.984251969) .BottomMargin = Application.InchesToPoints(0.984251969) .HeaderMargin = Application.InchesToPoints(0.4921259845) .FooterMargin = Application.InchesToPoints(0.4921259845) .PrintHeadings = False .PrintGridlines = True .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .PrintErrors = xlPrintErrorsDisplayed End With Application.DisplayAlerts = False chemin = "C:FICHIERS" nom_du_fichier = "ipmmat-" & zagence Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=chemin & nom_du_fichier & ".xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ActiveWindow.Close End Sub
MichD,
Tout d'abord merci et je te prie de bien vouloir excuser mon manque de
précisions.
A) Tu trouveras la macro Macro en fin de message. (il sagit plus d'un
enregistrement de macro qu'un développement)
B) Les fichiers écraseront les fichiers déjà existant et ils seront
créés si inexistant
C) Les colonnes A et B ne me serviront que pour le titre de l'état et
la rupture par agence, elle deviennent ensuite inutile.
D) l'Entête d'édition correspond pour moi à ce que l'on trouve dans
mise en page Entête/pied de page//Entête personalisée//Partie central e
E) peut importe le nom de la feuille, elle pourrait par exemple avoir
le code de l'agence.(pour le moment j'ai laissé feuill1).
Le projet aévolué mais, mon problème reste l'automatisation de la
division du fichier en fonction des codes agences présent dans le
fichiers. Le fichier d'origine contient les données de toutes les
agences, l'objectif est de faire un fichier par agence sans avoir à
alimenter "manuellement" les codes agences dans la macro.
Je pensais avoir posté ma réponse hier mais j'ai du me planter elle
n'est pas affichée aujourdhui.
Encore Merci à toi et à ceux qui me dirigeront vers une solution.
voici le source :
'Déclaration variable zagence pour utilisation inter macro
Public zagence As String
Sub ipmmat()
' chargement des datas récupérées par ftp
Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True,
Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2),
Array(2, 2), _
Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7,
2), Array(8, 2), Array(9, 2), _
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2),
Array(14, 2), Array(15, 2), Array( _
16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20,
2), Array(21, 2), Array(22, 1)) _
, TrailingMinusNumbers:=True
Selection.CurrentRegion.Select
Selection.Copy
' ouverture fichier entete
Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _
Origin:=xlWindows
' copie data dans fichier d'entete
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' mise en forme période achat mm-ssaa
Columns("V:V").Select
Selection.NumberFormat = "00-0000"
Range("A1").Select
' enregistrement fichier complet avec désactivation puis
réactivation msgbox
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes-
ag.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
' mise en place filtre
Range("A1").Select
Selection.AutoFilter
' mise en place agence et lancement macro agence
' Dim zagence As String
zagence = "01"
macro_agence
zagence = "02"
macro_agence
' Fermeture fichiers ouverts et sortie de l'application
Application.DisplayAlerts = False
ActiveWindow.Close
ActiveWindow.Close
Application.Quit
End Sub
' macro speciale agence
Sub macro_agence()
Selection.AutoFilter Field:=3, Criteria1:="=" & zagence
Selection.CurrentRegion.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("L:Q").Select
Selection.Delete Shift:=xlToLeft
Range("L1").Formula = "pos"
Range("M1").Formula =
"Commentaires "
Cells.Select
Range("A1").Activate
Cells.EntireColumn.AutoFit
Columns("A:B").Select
Selection.ColumnWidth = 0
Range("A1").Select
' mise en forme Edition
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Arial,Gras""&16INVENTAIRE PARC MATERIEL "
_
& Worksheets("Feuil1").Range("A2") & " " &
Worksheets("Feuil1").Range("B2")
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
Application.DisplayAlerts = False
chemin = "C:FICHIERS"
nom_du_fichier = "ipmmat-" & zagence
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=chemin & nom_du_fichier & ".xls",
_
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWindow.Close
End Sub
MichD, Tout d'abord merci et je te prie de bien vouloir excuser mon manque de précisions.
A) Tu trouveras la macro Macro en fin de message. (il sagit plus d'un enregistrement de macro qu'un développement) B) Les fichiers écraseront les fichiers déjà existant et ils seront créés si inexistant C) Les colonnes A et B ne me serviront que pour le titre de l'état et la rupture par agence, elle deviennent ensuite inutile. D) l'Entête d'édition correspond pour moi à ce que l'on trouve dans mise en page Entête/pied de page//Entête personalisée//Partie central e E) peut importe le nom de la feuille, elle pourrait par exemple avoir le code de l'agence.(pour le moment j'ai laissé feuill1).
Le projet aévolué mais, mon problème reste l'automatisation de la division du fichier en fonction des codes agences présent dans le fichiers. Le fichier d'origine contient les données de toutes les agences, l'objectif est de faire un fichier par agence sans avoir à alimenter "manuellement" les codes agences dans la macro.
Je pensais avoir posté ma réponse hier mais j'ai du me planter elle n'est pas affichée aujourdhui. Encore Merci à toi et à ceux qui me dirigeront vers une solution.
voici le source : 'Déclaration variable zagence pour utilisation inter macro Public zagence As String Sub ipmmat() ' chargement des datas récupérées par ftp Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _ xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _ ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True, Comma:úlse _ , Space:úlse, Other:úlse, FieldInfo:=Array(Array(1, 2), Array(2, 2), _ Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7, 2), Array(8, 2), Array(9, 2), _ Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array( _ 16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 2), Array(21, 2), Array(22, 1)) _ , TrailingMinusNumbers:=True Selection.CurrentRegion.Select Selection.Copy ' ouverture fichier entete Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _ Origin:=xlWindows ' copie data dans fichier d'entete Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse Application.CutCopyMode = False ' mise en forme période achat mm-ssaa Columns("V:V").Select Selection.NumberFormat = "00-0000" Range("A1").Select ' enregistrement fichier complet avec désactivation puis réactivation msgbox Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes- ag.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ' mise en place filtre Range("A1").Select Selection.AutoFilter ' mise en place agence et lancement macro agence ' Dim zagence As String zagence = "01" macro_agence zagence = "02" macro_agence ' Fermeture fichiers ouverts et sortie de l'application Application.DisplayAlerts = False ActiveWindow.Close ActiveWindow.Close Application.Quit End Sub ' macro speciale agence Sub macro_agence() Selection.AutoFilter Field:=3, Criteria1:="=" & zagence Selection.CurrentRegion.Select Selection.Copy Workbooks.Add ActiveSheet.Paste Columns("A:B").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("E:F").Select Selection.Delete Shift:=xlToLeft Columns("H:H").Select Selection.Delete Shift:=xlToLeft Columns("L:Q").Select Selection.Delete Shift:=xlToLeft Range("L1").Formula = "pos" Range("M1").Formula = "Commentaires " Cells.Select Range("A1").Activate Cells.EntireColumn.AutoFit Columns("A:B").Select Selection.ColumnWidth = 0 Range("A1").Select ' mise en forme Edition With ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "&""Arial,Gras""&16INVENTAIRE PARC MATERIEL " _ & Worksheets("Feuil1").Range("A2") & " " & Worksheets("Feuil1").Range("B2") .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.787401575) .RightMargin = Application.InchesToPoints(0.787401575) .TopMargin = Application.InchesToPoints(0.984251969) .BottomMargin = Application.InchesToPoints(0.984251969) .HeaderMargin = Application.InchesToPoints(0.4921259845) .FooterMargin = Application.InchesToPoints(0.4921259845) .PrintHeadings = False .PrintGridlines = True .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .PrintErrors = xlPrintErrorsDisplayed End With Application.DisplayAlerts = False chemin = "C:FICHIERS" nom_du_fichier = "ipmmat-" & zagence Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=chemin & nom_du_fichier & ".xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ActiveWindow.Close End Sub
MichD
Voici un fichier qui crée des fichiers sur le serveur à partir des données dans la colonne A du fichier dans lequel sera copiée la macro dans un module standard. La ligne 1 est réputée servir d'étiquette de colonne.
À copier dans un module standard et ne pas oublier de définir les 2 variables dans la procédure. '-------------------------------------------- Sub Création_Fichier_Sur_Serveur()
Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_Chemin As String
'********Variables à définir**********
Feuille = "Feuil1" 'nom de l'onglet de la feuille Serveur_Chemin = "serveurcheminsurserveur" 'à définir
On Error Resume Next 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False With Worksheets(Feuille) 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A 'Débutant en ligne 2, ligne 1 réservée pour les étiquettes For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With
'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count 'Si le fichier n'existe pas sur le serveur If Dir(Serveur_Chemin & C(A) & ".xls") = "" Then 'Création de celui-ci 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) With Sh .Range("A1") = "Code de l'agence" .Range("B1") = "Libellé de l'agence" .Range("C1") = "Famille matériel" .Range("D1") = "Sous-famille" .Range("E1") = "Code du matériel" .Range("F1") = "Désignation 1" .Range("G1") = "Désignation 2" .Range("H1") = "Marque" .Range("i1") = "Type" .Range("J1") = "N° Série" .Range("K1") = "Immatriculation" .Range("L1") = "Commentaires" .Range("M1") = "Commentaires" With .Range("A1:M1") .Font.Size = 14 .Font.Bold = True .EntireColumn.AutoFit End With End With 'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_Chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False End If Next Set Sh = Nothing: Set C = Nothing End Sub '--------------------------------------------
MichD ------------------------------------------ "MichD" a écrit dans le message de groupe de discussion : j7jg0c$g74$
Bonjour,
A ) Tu dis avoir développé une macro...jusqu'ici, tu sembles la garder pour toi !
B ) À chaque fois que tu fais rouler la macro, que doit-il se passer pour les fichiers qui ont déjà été créés ? 1. On recrée tous les fichiers sans exception avec les nouvelles données et on écrase les fichiers déjà existants ? 2. Tu veux seulement créer les fichiers inexistants sans toucher au fichier déjà créé ? 3. Autre à définir...
C ) Lors de la création des fichiers, tu veux y copier quoi ? Les colonnes A, B, et les données des colonnes E à P SEULEMENT ? Quelle disposition doivent avoir ces données dans le nouveau fichier? De A1 à Mx sans colonne vide ?
D ) C'est quoi pour toi : "l'entête de l'édition" ? La barre de titre de l'application lorsque le fichier est ouvert ? Autre chose ?
E ) Quel nom doit avoir la feuille dans chacun des fichiers créés ?
MichD ------------------------------------------ "kristofb" a écrit dans le message de groupe de discussion :
Bonjour à tous, Merci à ceux qui vont se pencher ... sans tomber sur mon cas.
J'ai un fichier avec des data par agences, le code de l'agence est en colonne A, le libellé en B les données vont de E à P. Le nombre de lignes par agence est variable et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre disponible sur un serveur pour chaque agence serveurcheminsurserveur XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais automatiser celà. Cerise sur le gateau, je souhaiterai avoir dans l'entête de l'édition le code et le libellé de l'agence.
Aujourd'hui dans une macro je met un code agence dans une zone et je lance une autre macro qui filtre sur ce code, qui copie les données dans un autre fichier et enregistre sur le serveur dans le bon répertoire. Et l'opération se répète autant de fois que je connais les agences. A chaque création je vais modifier ma macro... au secours.
De plus je conserve ma colonne A et B puisque je ne sais pas comment ajouter le code et le libellé de l'agence dans l'entête du tableau généré, ce qui me fait perdre une quarantaine de caractères dans la largeur de l'état.
Si l'un des Dieux de ce forum (les informaticiens étaient considérés comme tels il y a une vingtaine d'années) peut me guider vers une solution pratique je l'en remercie par avance.
L'urgent est fait, l'impossible est en cours, pour les mirables ... prévoir un délais.
Voici un fichier qui crée des fichiers sur le serveur à partir des données dans la colonne A
du fichier dans lequel sera copiée la macro dans un module standard. La ligne 1 est réputée
servir d'étiquette de colonne.
À copier dans un module standard et ne pas oublier de définir les 2 variables
dans la procédure.
'--------------------------------------------
Sub Création_Fichier_Sur_Serveur()
Dim C As New Collection, A As Integer
Dim Sh As Worksheet, Nb As Long
Dim Feuille As String, Serveur_Chemin As String
'********Variables à définir**********
Feuille = "Feuil1" 'nom de l'onglet de la feuille
Serveur_Chemin = "\serveurcheminsurserveur" 'à définir
On Error Resume Next
'Empêche le rafraîchissement de l'écran durant
'le temps que dure la macro.
Application.ScreenUpdating = False
With Worksheets(Feuille)
'Extrait le numéro dernière ligne colonne A
Nb = .Range("A65356").End(xlUp).Row
'Une boucle sur toutes les données de la colonne A
'Débutant en ligne 2, ligne 1 réservée pour les étiquettes
For A = 2 To Nb
'C est un objet collection qui permet d'ajouter seulement
'des éléments différents, donc pas de doublons. Chaque
'élément va servir à extraire des données dans un filtre
'automatique pour chaque No de police.
If .Range("A" & A).Value <> "" Then
C.Add .Range("A" & A).Text, .Range("A" & A).Value
End If
Next
End With
'Maintenant pour chaque élément de la collection de valeur unique
'de la colonne A
For A = 1 To C.Count
'Si le fichier n'existe pas sur le serveur
If Dir(Serveur_Chemin & C(A) & ".xls") = "" Then
'Création de celui-ci
'Ajoute un classeur ayant seulement une feuille
Workbooks.Add -4167
Set Sh = ActiveWorkbook.Worksheets(1)
'Le nom de cette feuille
Sh.Name = C(A)
With Sh
.Range("A1") = "Code de l'agence"
.Range("B1") = "Libellé de l'agence"
.Range("C1") = "Famille matériel"
.Range("D1") = "Sous-famille"
.Range("E1") = "Code du matériel"
.Range("F1") = "Désignation 1"
.Range("G1") = "Désignation 2"
.Range("H1") = "Marque"
.Range("i1") = "Type"
.Range("J1") = "N° Série"
.Range("K1") = "Immatriculation"
.Range("L1") = "Commentaires"
.Range("M1") = "Commentaires"
With .Range("A1:M1")
.Font.Size = 14
.Font.Bold = True
.EntireColumn.AutoFit
End With
End With
'Sauvegarde du fichier nouveau vers le serveur et le
'chemin du serveur en utilisant le code de l'agence
Sh.Parent.SaveAs Serveur_Chemin & C(A) & ".xls"
'Fermeture du nouveau fichier
Sh.Parent.Close False
End If
Next
Set Sh = Nothing: Set C = Nothing
End Sub
'--------------------------------------------
MichD
------------------------------------------
"MichD" a écrit dans le message de groupe de discussion : j7jg0c$g74$1@speranza.aioe.org...
Bonjour,
A )
Tu dis avoir développé une macro...jusqu'ici, tu sembles la garder pour toi !
B ) À chaque fois que tu fais rouler la macro, que doit-il se passer pour les fichiers qui ont déjà été créés ?
1. On recrée tous les fichiers sans exception avec les nouvelles données et on écrase les fichiers déjà existants ?
2. Tu veux seulement créer les fichiers inexistants sans toucher au fichier déjà créé ?
3. Autre à définir...
C ) Lors de la création des fichiers, tu veux y copier quoi ? Les colonnes A, B, et les données des colonnes E à P SEULEMENT
?
Quelle disposition doivent avoir ces données dans le nouveau fichier? De A1 à Mx sans colonne vide ?
D ) C'est quoi pour toi : "l'entête de l'édition" ? La barre de titre de l'application lorsque le fichier est ouvert ? Autre
chose ?
E ) Quel nom doit avoir la feuille dans chacun des fichiers créés ?
MichD
------------------------------------------
"kristofb" a écrit dans le message de groupe de discussion :
7a17fe3a-8147-4907-97d6-b12fa8a5f515@fk25g2000vbb.googlegroups.com...
Bonjour à tous,
Merci à ceux qui vont se pencher ... sans tomber sur mon cas.
J'ai un fichier avec des data par agences, le code de l'agence est en
colonne A, le libellé en B
les données vont de E à P. Le nombre de lignes par agence est variable
et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre
disponible sur un serveur pour chaque agence \serveurcheminsurserveur
XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais
automatiser celà.
Cerise sur le gateau, je souhaiterai avoir dans l'entête de l'édition
le code et le libellé de l'agence.
Aujourd'hui dans une macro je met un code agence dans une zone et je
lance une autre macro
qui filtre sur ce code, qui copie les données dans un autre fichier et
enregistre sur le serveur dans le bon répertoire.
Et l'opération se répète autant de fois que je connais les agences. A
chaque création je vais modifier ma macro... au secours.
De plus je conserve ma colonne A et B puisque je ne sais pas comment
ajouter le code et le libellé de l'agence dans l'entête du tableau
généré, ce qui me fait perdre une quarantaine de caractères dans la
largeur de l'état.
Si l'un des Dieux de ce forum (les informaticiens étaient considérés
comme tels il y a une vingtaine d'années) peut me guider vers une
solution pratique je l'en remercie par avance.
L'urgent est fait, l'impossible est en cours, pour les mirables ...
prévoir un délais.
Voici un fichier qui crée des fichiers sur le serveur à partir des données dans la colonne A du fichier dans lequel sera copiée la macro dans un module standard. La ligne 1 est réputée servir d'étiquette de colonne.
À copier dans un module standard et ne pas oublier de définir les 2 variables dans la procédure. '-------------------------------------------- Sub Création_Fichier_Sur_Serveur()
Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_Chemin As String
'********Variables à définir**********
Feuille = "Feuil1" 'nom de l'onglet de la feuille Serveur_Chemin = "serveurcheminsurserveur" 'à définir
On Error Resume Next 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False With Worksheets(Feuille) 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A 'Débutant en ligne 2, ligne 1 réservée pour les étiquettes For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With
'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count 'Si le fichier n'existe pas sur le serveur If Dir(Serveur_Chemin & C(A) & ".xls") = "" Then 'Création de celui-ci 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) With Sh .Range("A1") = "Code de l'agence" .Range("B1") = "Libellé de l'agence" .Range("C1") = "Famille matériel" .Range("D1") = "Sous-famille" .Range("E1") = "Code du matériel" .Range("F1") = "Désignation 1" .Range("G1") = "Désignation 2" .Range("H1") = "Marque" .Range("i1") = "Type" .Range("J1") = "N° Série" .Range("K1") = "Immatriculation" .Range("L1") = "Commentaires" .Range("M1") = "Commentaires" With .Range("A1:M1") .Font.Size = 14 .Font.Bold = True .EntireColumn.AutoFit End With End With 'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_Chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False End If Next Set Sh = Nothing: Set C = Nothing End Sub '--------------------------------------------
MichD ------------------------------------------ "MichD" a écrit dans le message de groupe de discussion : j7jg0c$g74$
Bonjour,
A ) Tu dis avoir développé une macro...jusqu'ici, tu sembles la garder pour toi !
B ) À chaque fois que tu fais rouler la macro, que doit-il se passer pour les fichiers qui ont déjà été créés ? 1. On recrée tous les fichiers sans exception avec les nouvelles données et on écrase les fichiers déjà existants ? 2. Tu veux seulement créer les fichiers inexistants sans toucher au fichier déjà créé ? 3. Autre à définir...
C ) Lors de la création des fichiers, tu veux y copier quoi ? Les colonnes A, B, et les données des colonnes E à P SEULEMENT ? Quelle disposition doivent avoir ces données dans le nouveau fichier? De A1 à Mx sans colonne vide ?
D ) C'est quoi pour toi : "l'entête de l'édition" ? La barre de titre de l'application lorsque le fichier est ouvert ? Autre chose ?
E ) Quel nom doit avoir la feuille dans chacun des fichiers créés ?
MichD ------------------------------------------ "kristofb" a écrit dans le message de groupe de discussion :
Bonjour à tous, Merci à ceux qui vont se pencher ... sans tomber sur mon cas.
J'ai un fichier avec des data par agences, le code de l'agence est en colonne A, le libellé en B les données vont de E à P. Le nombre de lignes par agence est variable et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre disponible sur un serveur pour chaque agence serveurcheminsurserveur XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais automatiser celà. Cerise sur le gateau, je souhaiterai avoir dans l'entête de l'édition le code et le libellé de l'agence.
Aujourd'hui dans une macro je met un code agence dans une zone et je lance une autre macro qui filtre sur ce code, qui copie les données dans un autre fichier et enregistre sur le serveur dans le bon répertoire. Et l'opération se répète autant de fois que je connais les agences. A chaque création je vais modifier ma macro... au secours.
De plus je conserve ma colonne A et B puisque je ne sais pas comment ajouter le code et le libellé de l'agence dans l'entête du tableau généré, ce qui me fait perdre une quarantaine de caractères dans la largeur de l'état.
Si l'un des Dieux de ce forum (les informaticiens étaient considérés comme tels il y a une vingtaine d'années) peut me guider vers une solution pratique je l'en remercie par avance.
L'urgent est fait, l'impossible est en cours, pour les mirables ... prévoir un délais.
"kristofb" a écrit J'ai un fichier avec des data par agences, le code de l'agence est en colonne A, le libellé en B les données vont de E à P. Le nombre de lignes par agence est variable et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre disponible sur un serveur pour chaque agence serveurcheminsurserveur XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais automatiser celà.
"kristofb" a écrit
J'ai un fichier avec des data par agences, le code de l'agence est en
colonne A, le libellé en B
les données vont de E à P. Le nombre de lignes par agence est variable
et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre
disponible sur un serveur pour chaque agence \serveurcheminsurserveur
XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais
automatiser celà.
"kristofb" a écrit J'ai un fichier avec des data par agences, le code de l'agence est en colonne A, le libellé en B les données vont de E à P. Le nombre de lignes par agence est variable et je ne connais pas à l'avance le nombre d'agences.
L'objectif est de générer un fichier par agence pour le rendre disponible sur un serveur pour chaque agence serveurcheminsurserveur XX où XX est le code de l'agence.
Le nombre des agences fluctu au cours des mois et je voudrais automatiser celà.
Bonjour à tous et merci à MichD et Maude. Les restrictions d'accès internet font que je ne peux travailler sur le lien de Maude, je regarderai celà ce WE de chez moi.
Concernant la solution de MichD, J'ai bien la création d'autant de fichier que nécessaire là où je souhaite les avoir, sous le bon nom, les feuilles sont bien nommées avec le code agence mais j'ai un soucis avec la récupération des datas.
Je ne maitrise pas suffisemment VBA mais je suppose que le problème est lié à mes codes agences qui peuvent être Alphanumérique 01 J0 T 1 par exemple. Qu'en pensez vous ?
2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous m'expliquer ?
Le source modifié 'Déclaration variables Public zagence As String Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_chemin As String Sub ipmmat() 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False ' chargement des datas récupérées par ftp Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _ xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _ ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True, Comma:úlse _ , Space:úlse, Other:úlse, FieldInfo:=Array(Array(1, 2), Array(2, 2), _ Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7, 2), Array(8, 2), Array(9, 2), _ Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array( _ 16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 2), Array(21, 2), Array(22, 1)) _ , TrailingMinusNumbers:=True Selection.CurrentRegion.Select Selection.Copy ' ouverture fichier entete Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _ Origin:=xlWindows ' copie data dans fichier d'entete Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse Application.CutCopyMode = False ' mise en forme période achat mm-ssaa Columns("V:V").Select Selection.NumberFormat = "00-0000" ' tri des données sur code agence Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers Range("A1").Select ' enregistrement fichier complet avec désactivation puis réactivation msgbox Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes- ag.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ' Suppression colonne Type de parc et région Columns("A:B").Select Selection.Delete Shift:=xlToLeft ' mise en place filtre Range("A1").Select Selection.AutoFilter ' La colonne A contient désormais les codes agences Feuille = "Feuil1" Serveur_chemin = "C:FICHIERSInventaire-Parc-Ag-" On Error Resume Next With Worksheets(Feuille) 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A Débutant en ligne 2 For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With 'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count ' Copie des données Selection.AutoFilter Field:=1, Criteria1:="=" & A Selection.CurrentRegion.Select Selection.Copy 'Si le fichier n'existe pas sur le serveur If Dir(Serveur_chemin & C(A) & ".xls") = "" Then 'Création de celui-ci 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) ActiveSheet.Paste With Sh .Range("A1") = "Code de l'agence" .Range("B1") = "Libellé de l'agence" .Range("C1") = "Famille matériel" .Range("D1") = "Sous-famille" .Range("E1") = "Code du matériel" .Range("F1") = "Désignation 1" .Range("G1") = "Désignation 2" .Range("H1") = "Marque" .Range("i1") = "Type" .Range("J1") = "N° Série" .Range("K1") = "Immatriculation" .Range("L1") = "Commentaires" .Range("M1") = "Commentaires" With .Range("A1:M1") .Font.Size = 14 .Font.Bold = True .EntireColumn.AutoFit End With End With 'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False End If Next Set Sh = Nothing: Set C = Nothing Application.DisplayAlerts = False ActiveWindow.Close ActiveWindow.Close Application.Quit End Sub
Bonjour à tous et merci à MichD et Maude.
Les restrictions d'accès internet font que je ne peux travailler sur
le lien de Maude,
je regarderai celà ce WE de chez moi.
Concernant la solution de MichD,
J'ai bien la création d'autant de fichier que nécessaire là où je
souhaite les avoir, sous le bon nom,
les feuilles sont bien nommées avec le code agence mais j'ai un soucis
avec la récupération des datas.
Je ne maitrise pas suffisemment VBA mais je suppose que le problème
est lié à mes codes agences qui peuvent être Alphanumérique 01 J0 T 1
par exemple. Qu'en pensez vous ?
2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous
m'expliquer ?
Le source modifié
'Déclaration variables
Public zagence As String
Dim C As New Collection, A As Integer
Dim Sh As Worksheet, Nb As Long
Dim Feuille As String, Serveur_chemin As String
Sub ipmmat()
'Empêche le rafraîchissement de l'écran durant
'le temps que dure la macro.
Application.ScreenUpdating = False
' chargement des datas récupérées par ftp
Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True,
Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2),
Array(2, 2), _
Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7,
2), Array(8, 2), Array(9, 2), _
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2),
Array(14, 2), Array(15, 2), Array( _
16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20,
2), Array(21, 2), Array(22, 1)) _
, TrailingMinusNumbers:=True
Selection.CurrentRegion.Select
Selection.Copy
' ouverture fichier entete
Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _
Origin:=xlWindows
' copie data dans fichier d'entete
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' mise en forme période achat mm-ssaa
Columns("V:V").Select
Selection.NumberFormat = "00-0000"
' tri des données sur code agence
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortTextAsNumbers
Range("A1").Select
' enregistrement fichier complet avec désactivation puis
réactivation msgbox
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes-
ag.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
' Suppression colonne Type de parc et région
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
' mise en place filtre
Range("A1").Select
Selection.AutoFilter
' La colonne A contient désormais les codes agences
Feuille = "Feuil1"
Serveur_chemin = "C:FICHIERSInventaire-Parc-Ag-"
On Error Resume Next
With Worksheets(Feuille)
'Extrait le numéro dernière ligne colonne A
Nb = .Range("A65356").End(xlUp).Row
'Une boucle sur toutes les données de la colonne A Débutant en
ligne 2
For A = 2 To Nb
'C est un objet collection qui permet d'ajouter seulement
'des éléments différents, donc pas de doublons. Chaque
'élément va servir à extraire des données dans un filtre
'automatique pour chaque No de police.
If .Range("A" & A).Value <> "" Then
C.Add .Range("A" & A).Text, .Range("A" & A).Value
End If
Next
End With
'Maintenant pour chaque élément de la collection de valeur unique
'de la colonne A
For A = 1 To C.Count
' Copie des données
Selection.AutoFilter Field:=1, Criteria1:="=" & A
Selection.CurrentRegion.Select
Selection.Copy
'Si le fichier n'existe pas sur le serveur
If Dir(Serveur_chemin & C(A) & ".xls") = "" Then
'Création de celui-ci
'Ajoute un classeur ayant seulement une feuille
Workbooks.Add -4167
Set Sh = ActiveWorkbook.Worksheets(1)
'Le nom de cette feuille
Sh.Name = C(A)
ActiveSheet.Paste
With Sh
.Range("A1") = "Code de l'agence"
.Range("B1") = "Libellé de l'agence"
.Range("C1") = "Famille matériel"
.Range("D1") = "Sous-famille"
.Range("E1") = "Code du matériel"
.Range("F1") = "Désignation 1"
.Range("G1") = "Désignation 2"
.Range("H1") = "Marque"
.Range("i1") = "Type"
.Range("J1") = "N° Série"
.Range("K1") = "Immatriculation"
.Range("L1") = "Commentaires"
.Range("M1") = "Commentaires"
With .Range("A1:M1")
.Font.Size = 14
.Font.Bold = True
.EntireColumn.AutoFit
End With
End With
'Sauvegarde du fichier nouveau vers le serveur et le
'chemin du serveur en utilisant le code de l'agence
Sh.Parent.SaveAs Serveur_chemin & C(A) & ".xls"
'Fermeture du nouveau fichier
Sh.Parent.Close False
End If
Next
Set Sh = Nothing: Set C = Nothing
Application.DisplayAlerts = False
ActiveWindow.Close
ActiveWindow.Close
Application.Quit
End Sub
Bonjour à tous et merci à MichD et Maude. Les restrictions d'accès internet font que je ne peux travailler sur le lien de Maude, je regarderai celà ce WE de chez moi.
Concernant la solution de MichD, J'ai bien la création d'autant de fichier que nécessaire là où je souhaite les avoir, sous le bon nom, les feuilles sont bien nommées avec le code agence mais j'ai un soucis avec la récupération des datas.
Je ne maitrise pas suffisemment VBA mais je suppose que le problème est lié à mes codes agences qui peuvent être Alphanumérique 01 J0 T 1 par exemple. Qu'en pensez vous ?
2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous m'expliquer ?
Le source modifié 'Déclaration variables Public zagence As String Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_chemin As String Sub ipmmat() 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False ' chargement des datas récupérées par ftp Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _ xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _ ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True, Comma:úlse _ , Space:úlse, Other:úlse, FieldInfo:=Array(Array(1, 2), Array(2, 2), _ Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7, 2), Array(8, 2), Array(9, 2), _ Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array( _ 16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 2), Array(21, 2), Array(22, 1)) _ , TrailingMinusNumbers:=True Selection.CurrentRegion.Select Selection.Copy ' ouverture fichier entete Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _ Origin:=xlWindows ' copie data dans fichier d'entete Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse Application.CutCopyMode = False ' mise en forme période achat mm-ssaa Columns("V:V").Select Selection.NumberFormat = "00-0000" ' tri des données sur code agence Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers Range("A1").Select ' enregistrement fichier complet avec désactivation puis réactivation msgbox Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes- ag.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ' Suppression colonne Type de parc et région Columns("A:B").Select Selection.Delete Shift:=xlToLeft ' mise en place filtre Range("A1").Select Selection.AutoFilter ' La colonne A contient désormais les codes agences Feuille = "Feuil1" Serveur_chemin = "C:FICHIERSInventaire-Parc-Ag-" On Error Resume Next With Worksheets(Feuille) 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A Débutant en ligne 2 For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With 'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count ' Copie des données Selection.AutoFilter Field:=1, Criteria1:="=" & A Selection.CurrentRegion.Select Selection.Copy 'Si le fichier n'existe pas sur le serveur If Dir(Serveur_chemin & C(A) & ".xls") = "" Then 'Création de celui-ci 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) ActiveSheet.Paste With Sh .Range("A1") = "Code de l'agence" .Range("B1") = "Libellé de l'agence" .Range("C1") = "Famille matériel" .Range("D1") = "Sous-famille" .Range("E1") = "Code du matériel" .Range("F1") = "Désignation 1" .Range("G1") = "Désignation 2" .Range("H1") = "Marque" .Range("i1") = "Type" .Range("J1") = "N° Série" .Range("K1") = "Immatriculation" .Range("L1") = "Commentaires" .Range("M1") = "Commentaires" With .Range("A1:M1") .Font.Size = 14 .Font.Bold = True .EntireColumn.AutoFit End With End With 'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False End If Next Set Sh = Nothing: Set C = Nothing Application.DisplayAlerts = False ActiveWindow.Close ActiveWindow.Close Application.Quit End Sub
kristofb
Re bonjour,
J'ai compris mon erreur sur le filtre ... j'ai mis Selection.AutoFilter Field:=1, Criteria1:="=" & A au lieu de Selection.AutoFilter Field:=1, Criteria1:="=" & C(A)
Merci de votre aide.
Re bonjour,
J'ai compris mon erreur sur le filtre ... j'ai mis
Selection.AutoFilter Field:=1, Criteria1:="=" & A
au lieu de
Selection.AutoFilter Field:=1, Criteria1:="=" & C(A)
J'ai compris mon erreur sur le filtre ... j'ai mis Selection.AutoFilter Field:=1, Criteria1:="=" & A au lieu de Selection.AutoFilter Field:=1, Criteria1:="=" & C(A)
Merci de votre aide.
MichD
| 2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous
Si tu places le curseur sur ADD à la ligne Workbooks.ADD et tu appelles l'aide VBA par F1
C'est ce que tu vas trouver : ================================================================== Workbooks.Add, méthode Cette méthode crée un nouveau classeur, qui devient le classeur actif. Syntaxe
expression.Add(Template) <<<<================== expression Variable qui représente un objet Workbooks.
Paramètres
Nom Obligatoire/Facultatif Type de données Description Template Facultatif Variante Détermine la façon dont le nouveau classeur est créé. Si cet argument est une chaîne spécifiant le nom d'un fichier Microsoft Excel existant, le nouveau classeur est créé d'après le modèle de ce fichier. Si cet argument est une constante, le nouveau classeur contient une seule feuille du type spécifié. Il peut s'agir d'une des constantes XlWBATemplate suivantes : xlWBATChart, xlWBATExcel4IntlMacroSheet, xlWBATExcel4MacroSheet ou xlWBATWorksheet. Si cet argument est omis, Microsoft Excel crée un nouveau classeur avec un certain nombre de feuilles vierges (ce nombre est défini par la propriété SheetsInNewWorkbook). ================================================================== Dans une macro, le "TEMPLATE" (TYPE DE CLASSEUR) à créer on peut le définir comme ceci : '----------------------------- Sub test() Dim X As XlWBATemplate X = xlWBATWorksheet 'X = -4167 'C'est la valeur numérique de la constante. C'est plus court à écrire ! ;-)) Workbooks.Add X
OU directement comme ceci : Workbooks.Add xlWBATWorksheet
Si on n'utilise pas de TEMPLATE, on aura un classeur avec le nombre de feuille défini par défaut des les options d'Excel. Workbooks.Add
End Sub '-----------------------------
Si dans la feuille, il y a des données à extraire, il aurait fallu utiliser ce type de macro :
'----------------------------------------------- Sub Filtre()
Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_Chemin As String
'********Variables à définir********** Feuille = "Feuil1" 'nom de l'onglet de la feuille Serveur_Chemin = "serveurcheminsurserveur"
On Error Resume Next 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False With Worksheets("Feuil1") 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A 'Débutant en ligne 2, ligne 1 réservée pour les étiquettes For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With Application.ScreenUpdating = False 'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count With Sheets("Feuil1").Range("A1:P" & Nb) .AutoFilter Field:=1, Criteria1:=C(A) End With 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) 'Copie de la plage filtrée vers la nouvelle feuille 'dans le nouveau classeur Worksheets(Feuille).Range("_FilterDataBase"). _ SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1") 'Suppression des colonnes C et D de la nouvelle feuille 'qui ne contient pas de données ou ces données ne sont 'pas pertinentes Sh.Range("C:D").EntireColumn.Delete Sh.Range("L1:M1") = "Commentaire" Sh.Range("A1:M1").Font.Size = 14 Sh.Range("A1:M1").Font.Bold = True Sh.Range("A1:M1").EntireColumn.AutoFit
'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_Chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False Next 'Enlever le filtre sur la feuille à la fin Sheets(Feuille).Range("A1").AutoFilter Application.ScreenUpdating = true Set Sh = Nothing: Set C = Nothing
End Sub '-----------------------------------------------
MichD ------------------------------------------ "kristofb" a écrit dans le message de groupe de discussion :
Bonjour à tous et merci à MichD et Maude. Les restrictions d'accès internet font que je ne peux travailler sur le lien de Maude, je regarderai celà ce WE de chez moi.
Concernant la solution de MichD, J'ai bien la création d'autant de fichier que nécessaire là où je souhaite les avoir, sous le bon nom, les feuilles sont bien nommées avec le code agence mais j'ai un soucis avec la récupération des datas.
Je ne maitrise pas suffisemment VBA mais je suppose que le problème est lié à mes codes agences qui peuvent être Alphanumérique 01 J0 T1 par exemple. Qu'en pensez vous ?
2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous m'expliquer ?
Le source modifié 'Déclaration variables Public zagence As String Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_chemin As String Sub ipmmat() 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False ' chargement des datas récupérées par ftp Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _ xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _ ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True, Comma:úlse _ , Space:úlse, Other:úlse, FieldInfo:=Array(Array(1, 2), Array(2, 2), _ Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7, 2), Array(8, 2), Array(9, 2), _ Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array( _ 16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 2), Array(21, 2), Array(22, 1)) _ , TrailingMinusNumbers:=True Selection.CurrentRegion.Select Selection.Copy ' ouverture fichier entete Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _ Origin:=xlWindows ' copie data dans fichier d'entete Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse Application.CutCopyMode = False ' mise en forme période achat mm-ssaa Columns("V:V").Select Selection.NumberFormat = "00-0000" ' tri des données sur code agence Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers Range("A1").Select ' enregistrement fichier complet avec désactivation puis réactivation msgbox Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes- ag.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ' Suppression colonne Type de parc et région Columns("A:B").Select Selection.Delete Shift:=xlToLeft ' mise en place filtre Range("A1").Select Selection.AutoFilter ' La colonne A contient désormais les codes agences Feuille = "Feuil1" Serveur_chemin = "C:FICHIERSInventaire-Parc-Ag-" On Error Resume Next With Worksheets(Feuille) 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A Débutant en ligne 2 For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With 'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count ' Copie des données Selection.AutoFilter Field:=1, Criteria1:="=" & A Selection.CurrentRegion.Select Selection.Copy 'Si le fichier n'existe pas sur le serveur If Dir(Serveur_chemin & C(A) & ".xls") = "" Then 'Création de celui-ci 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) ActiveSheet.Paste With Sh .Range("A1") = "Code de l'agence" .Range("B1") = "Libellé de l'agence" .Range("C1") = "Famille matériel" .Range("D1") = "Sous-famille" .Range("E1") = "Code du matériel" .Range("F1") = "Désignation 1" .Range("G1") = "Désignation 2" .Range("H1") = "Marque" .Range("i1") = "Type" .Range("J1") = "N° Série" .Range("K1") = "Immatriculation" .Range("L1") = "Commentaires" .Range("M1") = "Commentaires" With .Range("A1:M1") .Font.Size = 14 .Font.Bold = True .EntireColumn.AutoFit End With End With 'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False End If Next Set Sh = Nothing: Set C = Nothing Application.DisplayAlerts = False ActiveWindow.Close ActiveWindow.Close Application.Quit End Sub
| 2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous
Si tu places le curseur sur ADD à la ligne Workbooks.ADD et tu appelles l'aide VBA par F1
C'est ce que tu vas trouver :
================================================================== Workbooks.Add, méthode
Cette méthode crée un nouveau classeur, qui devient le classeur actif.
Syntaxe
expression.Add(Template) <<<<==================
expression Variable qui représente un objet Workbooks.
Paramètres
Nom Obligatoire/Facultatif Type de données Description
Template Facultatif Variante Détermine la façon dont le nouveau classeur est créé. Si cet argument est une chaîne spécifiant
le nom d'un fichier Microsoft Excel existant, le nouveau classeur est créé d'après le modèle de ce fichier. Si cet argument
est une constante, le nouveau classeur contient une seule feuille du type spécifié. Il peut s'agir d'une des constantes
XlWBATemplate suivantes : xlWBATChart, xlWBATExcel4IntlMacroSheet, xlWBATExcel4MacroSheet ou xlWBATWorksheet. Si cet argument
est omis, Microsoft Excel crée un nouveau classeur avec un certain nombre de feuilles vierges (ce nombre est défini par la
propriété SheetsInNewWorkbook).
==================================================================
Dans une macro, le "TEMPLATE" (TYPE DE CLASSEUR) à créer on peut le définir comme ceci :
'-----------------------------
Sub test()
Dim X As XlWBATemplate
X = xlWBATWorksheet
'X = -4167 'C'est la valeur numérique de la constante. C'est plus court à écrire ! ;-))
Workbooks.Add X
OU directement comme ceci :
Workbooks.Add xlWBATWorksheet
Si on n'utilise pas de TEMPLATE, on aura un classeur avec le nombre
de feuille défini par défaut des les options d'Excel.
Workbooks.Add
End Sub
'-----------------------------
Si dans la feuille, il y a des données à extraire, il aurait fallu utiliser ce type de macro :
'-----------------------------------------------
Sub Filtre()
Dim C As New Collection, A As Integer
Dim Sh As Worksheet, Nb As Long
Dim Feuille As String, Serveur_Chemin As String
'********Variables à définir**********
Feuille = "Feuil1" 'nom de l'onglet de la feuille
Serveur_Chemin = "\serveurcheminsurserveur"
On Error Resume Next
'Empêche le rafraîchissement de l'écran durant
'le temps que dure la macro.
Application.ScreenUpdating = False
With Worksheets("Feuil1")
'Extrait le numéro dernière ligne colonne A
Nb = .Range("A65356").End(xlUp).Row
'Une boucle sur toutes les données de la colonne A
'Débutant en ligne 2, ligne 1 réservée pour les étiquettes
For A = 2 To Nb
'C est un objet collection qui permet d'ajouter seulement
'des éléments différents, donc pas de doublons. Chaque
'élément va servir à extraire des données dans un filtre
'automatique pour chaque No de police.
If .Range("A" & A).Value <> "" Then
C.Add .Range("A" & A).Text, .Range("A" & A).Value
End If
Next
End With
Application.ScreenUpdating = False
'Maintenant pour chaque élément de la collection de valeur unique
'de la colonne A
For A = 1 To C.Count
With Sheets("Feuil1").Range("A1:P" & Nb)
.AutoFilter Field:=1, Criteria1:=C(A)
End With
'Ajoute un classeur ayant seulement une feuille
Workbooks.Add -4167
Set Sh = ActiveWorkbook.Worksheets(1)
'Le nom de cette feuille
Sh.Name = C(A)
'Copie de la plage filtrée vers la nouvelle feuille
'dans le nouveau classeur
Worksheets(Feuille).Range("_FilterDataBase"). _
SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
'Suppression des colonnes C et D de la nouvelle feuille
'qui ne contient pas de données ou ces données ne sont
'pas pertinentes
Sh.Range("C:D").EntireColumn.Delete
Sh.Range("L1:M1") = "Commentaire"
Sh.Range("A1:M1").Font.Size = 14
Sh.Range("A1:M1").Font.Bold = True
Sh.Range("A1:M1").EntireColumn.AutoFit
'Sauvegarde du fichier nouveau vers le serveur et le
'chemin du serveur en utilisant le code de l'agence
Sh.Parent.SaveAs Serveur_Chemin & C(A) & ".xls"
'Fermeture du nouveau fichier
Sh.Parent.Close False
Next
'Enlever le filtre sur la feuille à la fin
Sheets(Feuille).Range("A1").AutoFilter
Application.ScreenUpdating = true
Set Sh = Nothing: Set C = Nothing
End Sub
'-----------------------------------------------
MichD
------------------------------------------
"kristofb" a écrit dans le message de groupe de discussion :
a6c0b693-c2ba-4778-8aaa-942d405080ec@m4g2000yqm.googlegroups.com...
Bonjour à tous et merci à MichD et Maude.
Les restrictions d'accès internet font que je ne peux travailler sur
le lien de Maude,
je regarderai celà ce WE de chez moi.
Concernant la solution de MichD,
J'ai bien la création d'autant de fichier que nécessaire là où je
souhaite les avoir, sous le bon nom,
les feuilles sont bien nommées avec le code agence mais j'ai un soucis
avec la récupération des datas.
Je ne maitrise pas suffisemment VBA mais je suppose que le problème
est lié à mes codes agences qui peuvent être Alphanumérique 01 J0 T1
par exemple. Qu'en pensez vous ?
2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous
m'expliquer ?
Le source modifié
'Déclaration variables
Public zagence As String
Dim C As New Collection, A As Integer
Dim Sh As Worksheet, Nb As Long
Dim Feuille As String, Serveur_chemin As String
Sub ipmmat()
'Empêche le rafraîchissement de l'écran durant
'le temps que dure la macro.
Application.ScreenUpdating = False
' chargement des datas récupérées par ftp
Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlNone, _
ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True,
Comma:úlse _
, Space:úlse, Other:úlse, FieldInfo:=Array(Array(1, 2),
Array(2, 2), _
Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7,
2), Array(8, 2), Array(9, 2), _
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2),
Array(14, 2), Array(15, 2), Array( _
16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20,
2), Array(21, 2), Array(22, 1)) _
, TrailingMinusNumbers:=True
Selection.CurrentRegion.Select
Selection.Copy
' ouverture fichier entete
Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _
Origin:=xlWindows
' copie data dans fichier d'entete
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.CutCopyMode = False
' mise en forme période achat mm-ssaa
Columns("V:V").Select
Selection.NumberFormat = "00-0000"
' tri des données sur code agence
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortTextAsNumbers
Range("A1").Select
' enregistrement fichier complet avec désactivation puis
réactivation msgbox
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes-
ag.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:úlse, CreateBackup:úlse
Application.DisplayAlerts = True
' Suppression colonne Type de parc et région
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
' mise en place filtre
Range("A1").Select
Selection.AutoFilter
' La colonne A contient désormais les codes agences
Feuille = "Feuil1"
Serveur_chemin = "C:FICHIERSInventaire-Parc-Ag-"
On Error Resume Next
With Worksheets(Feuille)
'Extrait le numéro dernière ligne colonne A
Nb = .Range("A65356").End(xlUp).Row
'Une boucle sur toutes les données de la colonne A Débutant en
ligne 2
For A = 2 To Nb
'C est un objet collection qui permet d'ajouter seulement
'des éléments différents, donc pas de doublons. Chaque
'élément va servir à extraire des données dans un filtre
'automatique pour chaque No de police.
If .Range("A" & A).Value <> "" Then
C.Add .Range("A" & A).Text, .Range("A" & A).Value
End If
Next
End With
'Maintenant pour chaque élément de la collection de valeur unique
'de la colonne A
For A = 1 To C.Count
' Copie des données
Selection.AutoFilter Field:=1, Criteria1:="=" & A
Selection.CurrentRegion.Select
Selection.Copy
'Si le fichier n'existe pas sur le serveur
If Dir(Serveur_chemin & C(A) & ".xls") = "" Then
'Création de celui-ci
'Ajoute un classeur ayant seulement une feuille
Workbooks.Add -4167
Set Sh = ActiveWorkbook.Worksheets(1)
'Le nom de cette feuille
Sh.Name = C(A)
ActiveSheet.Paste
With Sh
.Range("A1") = "Code de l'agence"
.Range("B1") = "Libellé de l'agence"
.Range("C1") = "Famille matériel"
.Range("D1") = "Sous-famille"
.Range("E1") = "Code du matériel"
.Range("F1") = "Désignation 1"
.Range("G1") = "Désignation 2"
.Range("H1") = "Marque"
.Range("i1") = "Type"
.Range("J1") = "N° Série"
.Range("K1") = "Immatriculation"
.Range("L1") = "Commentaires"
.Range("M1") = "Commentaires"
With .Range("A1:M1")
.Font.Size = 14
.Font.Bold = True
.EntireColumn.AutoFit
End With
End With
'Sauvegarde du fichier nouveau vers le serveur et le
'chemin du serveur en utilisant le code de l'agence
Sh.Parent.SaveAs Serveur_chemin & C(A) & ".xls"
'Fermeture du nouveau fichier
Sh.Parent.Close False
End If
Next
Set Sh = Nothing: Set C = Nothing
Application.DisplayAlerts = False
ActiveWindow.Close
ActiveWindow.Close
Application.Quit
End Sub
| 2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous
Si tu places le curseur sur ADD à la ligne Workbooks.ADD et tu appelles l'aide VBA par F1
C'est ce que tu vas trouver : ================================================================== Workbooks.Add, méthode Cette méthode crée un nouveau classeur, qui devient le classeur actif. Syntaxe
expression.Add(Template) <<<<================== expression Variable qui représente un objet Workbooks.
Paramètres
Nom Obligatoire/Facultatif Type de données Description Template Facultatif Variante Détermine la façon dont le nouveau classeur est créé. Si cet argument est une chaîne spécifiant le nom d'un fichier Microsoft Excel existant, le nouveau classeur est créé d'après le modèle de ce fichier. Si cet argument est une constante, le nouveau classeur contient une seule feuille du type spécifié. Il peut s'agir d'une des constantes XlWBATemplate suivantes : xlWBATChart, xlWBATExcel4IntlMacroSheet, xlWBATExcel4MacroSheet ou xlWBATWorksheet. Si cet argument est omis, Microsoft Excel crée un nouveau classeur avec un certain nombre de feuilles vierges (ce nombre est défini par la propriété SheetsInNewWorkbook). ================================================================== Dans une macro, le "TEMPLATE" (TYPE DE CLASSEUR) à créer on peut le définir comme ceci : '----------------------------- Sub test() Dim X As XlWBATemplate X = xlWBATWorksheet 'X = -4167 'C'est la valeur numérique de la constante. C'est plus court à écrire ! ;-)) Workbooks.Add X
OU directement comme ceci : Workbooks.Add xlWBATWorksheet
Si on n'utilise pas de TEMPLATE, on aura un classeur avec le nombre de feuille défini par défaut des les options d'Excel. Workbooks.Add
End Sub '-----------------------------
Si dans la feuille, il y a des données à extraire, il aurait fallu utiliser ce type de macro :
'----------------------------------------------- Sub Filtre()
Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_Chemin As String
'********Variables à définir********** Feuille = "Feuil1" 'nom de l'onglet de la feuille Serveur_Chemin = "serveurcheminsurserveur"
On Error Resume Next 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False With Worksheets("Feuil1") 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A 'Débutant en ligne 2, ligne 1 réservée pour les étiquettes For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With Application.ScreenUpdating = False 'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count With Sheets("Feuil1").Range("A1:P" & Nb) .AutoFilter Field:=1, Criteria1:=C(A) End With 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) 'Copie de la plage filtrée vers la nouvelle feuille 'dans le nouveau classeur Worksheets(Feuille).Range("_FilterDataBase"). _ SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1") 'Suppression des colonnes C et D de la nouvelle feuille 'qui ne contient pas de données ou ces données ne sont 'pas pertinentes Sh.Range("C:D").EntireColumn.Delete Sh.Range("L1:M1") = "Commentaire" Sh.Range("A1:M1").Font.Size = 14 Sh.Range("A1:M1").Font.Bold = True Sh.Range("A1:M1").EntireColumn.AutoFit
'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_Chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False Next 'Enlever le filtre sur la feuille à la fin Sheets(Feuille).Range("A1").AutoFilter Application.ScreenUpdating = true Set Sh = Nothing: Set C = Nothing
End Sub '-----------------------------------------------
MichD ------------------------------------------ "kristofb" a écrit dans le message de groupe de discussion :
Bonjour à tous et merci à MichD et Maude. Les restrictions d'accès internet font que je ne peux travailler sur le lien de Maude, je regarderai celà ce WE de chez moi.
Concernant la solution de MichD, J'ai bien la création d'autant de fichier que nécessaire là où je souhaite les avoir, sous le bon nom, les feuilles sont bien nommées avec le code agence mais j'ai un soucis avec la récupération des datas.
Je ne maitrise pas suffisemment VBA mais je suppose que le problème est lié à mes codes agences qui peuvent être Alphanumérique 01 J0 T1 par exemple. Qu'en pensez vous ?
2) Workbooks.Add celà me parle mais pas -4167 pouvez-vous m'expliquer ?
Le source modifié 'Déclaration variables Public zagence As String Dim C As New Collection, A As Integer Dim Sh As Worksheet, Nb As Long Dim Feuille As String, Serveur_chemin As String Sub ipmmat() 'Empêche le rafraîchissement de l'écran durant 'le temps que dure la macro. Application.ScreenUpdating = False ' chargement des datas récupérées par ftp Workbooks.OpenText Filename:="C:FICHIERSfipmmat.txt", Origin:= _ xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _ ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True, Comma:úlse _ , Space:úlse, Other:úlse, FieldInfo:=Array(Array(1, 2), Array(2, 2), _ Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), Array(7, 2), Array(8, 2), Array(9, 2), _ Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array( _ 16, 2), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 2), Array(21, 2), Array(22, 1)) _ , TrailingMinusNumbers:=True Selection.CurrentRegion.Select Selection.Copy ' ouverture fichier entete Workbooks.Open Filename:="C:Tableaux RS6000fipmmat-vide.xls", _ Origin:=xlWindows ' copie data dans fichier d'entete Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :úlse, Transpose:úlse Application.CutCopyMode = False ' mise en forme période achat mm-ssaa Columns("V:V").Select Selection.NumberFormat = "00-0000" ' tri des données sur code agence Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers Range("A1").Select ' enregistrement fichier complet avec désactivation puis réactivation msgbox Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:FICHIERSfipmmat-toutes- ag.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:úlse, CreateBackup:úlse Application.DisplayAlerts = True ' Suppression colonne Type de parc et région Columns("A:B").Select Selection.Delete Shift:=xlToLeft ' mise en place filtre Range("A1").Select Selection.AutoFilter ' La colonne A contient désormais les codes agences Feuille = "Feuil1" Serveur_chemin = "C:FICHIERSInventaire-Parc-Ag-" On Error Resume Next With Worksheets(Feuille) 'Extrait le numéro dernière ligne colonne A Nb = .Range("A65356").End(xlUp).Row 'Une boucle sur toutes les données de la colonne A Débutant en ligne 2 For A = 2 To Nb 'C est un objet collection qui permet d'ajouter seulement 'des éléments différents, donc pas de doublons. Chaque 'élément va servir à extraire des données dans un filtre 'automatique pour chaque No de police. If .Range("A" & A).Value <> "" Then C.Add .Range("A" & A).Text, .Range("A" & A).Value End If Next End With 'Maintenant pour chaque élément de la collection de valeur unique 'de la colonne A For A = 1 To C.Count ' Copie des données Selection.AutoFilter Field:=1, Criteria1:="=" & A Selection.CurrentRegion.Select Selection.Copy 'Si le fichier n'existe pas sur le serveur If Dir(Serveur_chemin & C(A) & ".xls") = "" Then 'Création de celui-ci 'Ajoute un classeur ayant seulement une feuille Workbooks.Add -4167 Set Sh = ActiveWorkbook.Worksheets(1) 'Le nom de cette feuille Sh.Name = C(A) ActiveSheet.Paste With Sh .Range("A1") = "Code de l'agence" .Range("B1") = "Libellé de l'agence" .Range("C1") = "Famille matériel" .Range("D1") = "Sous-famille" .Range("E1") = "Code du matériel" .Range("F1") = "Désignation 1" .Range("G1") = "Désignation 2" .Range("H1") = "Marque" .Range("i1") = "Type" .Range("J1") = "N° Série" .Range("K1") = "Immatriculation" .Range("L1") = "Commentaires" .Range("M1") = "Commentaires" With .Range("A1:M1") .Font.Size = 14 .Font.Bold = True .EntireColumn.AutoFit End With End With 'Sauvegarde du fichier nouveau vers le serveur et le 'chemin du serveur en utilisant le code de l'agence Sh.Parent.SaveAs Serveur_chemin & C(A) & ".xls" 'Fermeture du nouveau fichier Sh.Parent.Close False End If Next Set Sh = Nothing: Set C = Nothing Application.DisplayAlerts = False ActiveWindow.Close ActiveWindow.Close Application.Quit End Sub
