Salut tout le monde,
j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...) :
Je cherche à créer une macro qui me permettrait de gagner des heures de
boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
(variable) et de colonnes (A - C).
Exemple :
(A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
(A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
(A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
Je dois :
1- créer un onglet par numéro trouvé en C mais ne pas en créer un
supplémentaire si le numéro se répète plusieurs fois
ex : 1 fois onglet "123456" et 1 fois onglet "456789"
2- copier dans l'onglet correspondant au numéro, les valeurs des x lignes
de
"Général"
onglet "123456"
(A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
(A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
onglet "456789"
(A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
3-recopier les x lignes et colonnes (A:C) de "Général" et les coller dans
un
document Word XP "liste.doc" (collage spécial - coller Texte sans mise en
forme)
Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
suffisantes pour y arriver, d'où mon SOS.
Merci pour le coup de main.
--
Céd / Lausanne
Salut tout le monde,
j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...) :
Je cherche à créer une macro qui me permettrait de gagner des heures de
boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
(variable) et de colonnes (A - C).
Exemple :
(A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
(A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
(A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
Je dois :
1- créer un onglet par numéro trouvé en C mais ne pas en créer un
supplémentaire si le numéro se répète plusieurs fois
ex : 1 fois onglet "123456" et 1 fois onglet "456789"
2- copier dans l'onglet correspondant au numéro, les valeurs des x lignes
de
"Général"
onglet "123456"
(A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
(A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
onglet "456789"
(A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
3-recopier les x lignes et colonnes (A:C) de "Général" et les coller dans
un
document Word XP "liste.doc" (collage spécial - coller Texte sans mise en
forme)
Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
suffisantes pour y arriver, d'où mon SOS.
Merci pour le coup de main.
--
Céd / Lausanne
Salut tout le monde,
j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...) :
Je cherche à créer une macro qui me permettrait de gagner des heures de
boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
(variable) et de colonnes (A - C).
Exemple :
(A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
(A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
(A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
Je dois :
1- créer un onglet par numéro trouvé en C mais ne pas en créer un
supplémentaire si le numéro se répète plusieurs fois
ex : 1 fois onglet "123456" et 1 fois onglet "456789"
2- copier dans l'onglet correspondant au numéro, les valeurs des x lignes
de
"Général"
onglet "123456"
(A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
(A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
onglet "456789"
(A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
3-recopier les x lignes et colonnes (A:C) de "Général" et les coller dans
un
document Word XP "liste.doc" (collage spécial - coller Texte sans mise en
forme)
Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
suffisantes pour y arriver, d'où mon SOS.
Merci pour le coup de main.
--
Céd / Lausanne
Bonsoir,
Test sur une copie de ton classeur pour voir le résultat. Les valeurs de la
feuille "Général" sont inscritent dans un tableau dans le document Word (ce
qui me paraît logique mais adapte si tu veux autre chose). Les commentaires
sont dans le code (qui fait un peu usine à gaz) pour que tu comprenne le
fonctionnement :
Sub CreerFeuillePuisWord()
Dim Fe As Worksheet
Dim FeAjoutee As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Col As Collection
Dim CelVide As Range
Dim I As Long
'pour Word
Dim AppWord As Object
Dim Doc As Object
Dim TableWd As Object
Dim NBLigne As Long
Dim NBColonne As Integer
Set Fe = Worksheets("Général")
Set Col = New Collection
'défini la plage (colonne C)
With Fe
Set Plage = .Range(.[C1], .[C65536].End(3))
End With
'ajoute le nom des feuilles existantes
'à la collection au cas où elles auraient
'déjà été crées sinon, les supprimer avant
For I = 1 To Worksheets.Count
Col.Add Worksheets(I).Name, Worksheets(I).Name
Next I
'parcour la plage
For Each Cel In Plage
'ajoute le N° à la collection
'ce qui crée une erreur si il existe déjà !
On Error Resume Next
Col.Add Cel.Value, CStr(Cel.Value)
'si ce n'est pas le cas, ajoute une feuille
'la renomme et la place après la feuille "Général"
'et copie la ligne dans la 1ère ligne de la feuille
'normal puisque la feuille vient d'être crée
'elle est donc vierge !!!
If Err.Number = 0 Then
Set FeAjoutee = Worksheets.Add
FeAjoutee.Name = Cel.Value
FeAjoutee.Move , Fe
Cel.EntireRow.Copy FeAjoutee.[A1]
'dans le cas contraire, la feuille existe déjà
'la première ligne vide est alors recherchée
'et la ligne est collée
Else
With Worksheets(CStr(Cel.Value))
Set CelVide = .[A65536].End(3).Offset(1, 0)
End With
Cel.EntireRow.Copy CelVide
End If
Next Cel
'crée une instance de Word
Set AppWord = CreateObject("Word.Application")
'redéfini la plage (ici colonne A pour plus de clarté à cause des
Offsets)
'et recherche le nombre de lignes et colonnes pour la création de la
table
'dans Word
With Fe
Set Plage = .Range(.[A1], .[A65536].End(3))
NBLigne = .Cells.Find("*", .[A1], -4123, , 1, 2).Row
NBColonne = .Cells.Find("*", .[A1], -4123, , 2, 2).Column
End With
'remet I à zéro pour ajout dans la table
I = 0
'supprime un éventuel document avant d'en créer un autre
Kill ThisWorkbook.Path & "Général.doc"
With AppWord
.Visible = True
'ajout d'un nouveau document
Set Doc = .Documents.Add
With Doc
'crée la table
Set TableWd = .Tables.Add(.Range, NBLigne, NBColonne, 1, 1)
With TableWd
'ajoute les valeurs
For Each Cel In Plage
I = I + 1
.Cell(I, 1).Range.Text = Trim(Cel.Text)
.Cell(I, 2).Range.Text = Trim(Cel.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(Cel.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(Cel.Offset(0, 3).Text)
Next Cel
End With
'enregistre dans le même dossier que le classeur
'en lui donnant le nom de la feuille (Général)
.SaveAs ThisWorkbook.Path & "Général.doc"
'ferme le document
'>>>.Close
End With
'ferme Word
'>>>.Quit
End With
Set Cel = Nothing
Set CelVide = Nothing
Set Plage = Nothing
Set Fe = Nothing
Set FeAjoutee = Nothing
Set AppWord = Nothing
Set Doc = Nothing
Set TableWd = Nothing
Set Col = Nothing
End Sub
Hervé.
"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message de
news:
> Salut tout le monde,
>
> j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...) :
> Je cherche à créer une macro qui me permettrait de gagner des heures de
> boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
> (variable) et de colonnes (A - C).
> Exemple :
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
> (A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
>
> Je dois :
> 1- créer un onglet par numéro trouvé en C mais ne pas en créer un
> supplémentaire si le numéro se répète plusieurs fois
> ex : 1 fois onglet "123456" et 1 fois onglet "456789"
>
> 2- copier dans l'onglet correspondant au numéro, les valeurs des x lignes
> de
> "Général"
> onglet "123456"
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
> onglet "456789"
> (A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
>
> 3-recopier les x lignes et colonnes (A:C) de "Général" et les coller dans
> un
> document Word XP "liste.doc" (collage spécial - coller Texte sans mise en
> forme)
>
> Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
> suffisantes pour y arriver, d'où mon SOS.
>
> Merci pour le coup de main.
> --
> Céd / Lausanne
Bonsoir,
Test sur une copie de ton classeur pour voir le résultat. Les valeurs de la
feuille "Général" sont inscritent dans un tableau dans le document Word (ce
qui me paraît logique mais adapte si tu veux autre chose). Les commentaires
sont dans le code (qui fait un peu usine à gaz) pour que tu comprenne le
fonctionnement :
Sub CreerFeuillePuisWord()
Dim Fe As Worksheet
Dim FeAjoutee As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Col As Collection
Dim CelVide As Range
Dim I As Long
'pour Word
Dim AppWord As Object
Dim Doc As Object
Dim TableWd As Object
Dim NBLigne As Long
Dim NBColonne As Integer
Set Fe = Worksheets("Général")
Set Col = New Collection
'défini la plage (colonne C)
With Fe
Set Plage = .Range(.[C1], .[C65536].End(3))
End With
'ajoute le nom des feuilles existantes
'à la collection au cas où elles auraient
'déjà été crées sinon, les supprimer avant
For I = 1 To Worksheets.Count
Col.Add Worksheets(I).Name, Worksheets(I).Name
Next I
'parcour la plage
For Each Cel In Plage
'ajoute le N° à la collection
'ce qui crée une erreur si il existe déjà !
On Error Resume Next
Col.Add Cel.Value, CStr(Cel.Value)
'si ce n'est pas le cas, ajoute une feuille
'la renomme et la place après la feuille "Général"
'et copie la ligne dans la 1ère ligne de la feuille
'normal puisque la feuille vient d'être crée
'elle est donc vierge !!!
If Err.Number = 0 Then
Set FeAjoutee = Worksheets.Add
FeAjoutee.Name = Cel.Value
FeAjoutee.Move , Fe
Cel.EntireRow.Copy FeAjoutee.[A1]
'dans le cas contraire, la feuille existe déjà
'la première ligne vide est alors recherchée
'et la ligne est collée
Else
With Worksheets(CStr(Cel.Value))
Set CelVide = .[A65536].End(3).Offset(1, 0)
End With
Cel.EntireRow.Copy CelVide
End If
Next Cel
'crée une instance de Word
Set AppWord = CreateObject("Word.Application")
'redéfini la plage (ici colonne A pour plus de clarté à cause des
Offsets)
'et recherche le nombre de lignes et colonnes pour la création de la
table
'dans Word
With Fe
Set Plage = .Range(.[A1], .[A65536].End(3))
NBLigne = .Cells.Find("*", .[A1], -4123, , 1, 2).Row
NBColonne = .Cells.Find("*", .[A1], -4123, , 2, 2).Column
End With
'remet I à zéro pour ajout dans la table
I = 0
'supprime un éventuel document avant d'en créer un autre
Kill ThisWorkbook.Path & "Général.doc"
With AppWord
.Visible = True
'ajout d'un nouveau document
Set Doc = .Documents.Add
With Doc
'crée la table
Set TableWd = .Tables.Add(.Range, NBLigne, NBColonne, 1, 1)
With TableWd
'ajoute les valeurs
For Each Cel In Plage
I = I + 1
.Cell(I, 1).Range.Text = Trim(Cel.Text)
.Cell(I, 2).Range.Text = Trim(Cel.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(Cel.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(Cel.Offset(0, 3).Text)
Next Cel
End With
'enregistre dans le même dossier que le classeur
'en lui donnant le nom de la feuille (Général)
.SaveAs ThisWorkbook.Path & "Général.doc"
'ferme le document
'>>>.Close
End With
'ferme Word
'>>>.Quit
End With
Set Cel = Nothing
Set CelVide = Nothing
Set Plage = Nothing
Set Fe = Nothing
Set FeAjoutee = Nothing
Set AppWord = Nothing
Set Doc = Nothing
Set TableWd = Nothing
Set Col = Nothing
End Sub
Hervé.
"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message de
news: 847F7B06-2980-4C20-954B-81F9F1815C7F@microsoft.com...
> Salut tout le monde,
>
> j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...) :
> Je cherche à créer une macro qui me permettrait de gagner des heures de
> boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
> (variable) et de colonnes (A - C).
> Exemple :
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
> (A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
>
> Je dois :
> 1- créer un onglet par numéro trouvé en C mais ne pas en créer un
> supplémentaire si le numéro se répète plusieurs fois
> ex : 1 fois onglet "123456" et 1 fois onglet "456789"
>
> 2- copier dans l'onglet correspondant au numéro, les valeurs des x lignes
> de
> "Général"
> onglet "123456"
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
> onglet "456789"
> (A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
>
> 3-recopier les x lignes et colonnes (A:C) de "Général" et les coller dans
> un
> document Word XP "liste.doc" (collage spécial - coller Texte sans mise en
> forme)
>
> Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
> suffisantes pour y arriver, d'où mon SOS.
>
> Merci pour le coup de main.
> --
> Céd / Lausanne
Bonsoir,
Test sur une copie de ton classeur pour voir le résultat. Les valeurs de la
feuille "Général" sont inscritent dans un tableau dans le document Word (ce
qui me paraît logique mais adapte si tu veux autre chose). Les commentaires
sont dans le code (qui fait un peu usine à gaz) pour que tu comprenne le
fonctionnement :
Sub CreerFeuillePuisWord()
Dim Fe As Worksheet
Dim FeAjoutee As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Col As Collection
Dim CelVide As Range
Dim I As Long
'pour Word
Dim AppWord As Object
Dim Doc As Object
Dim TableWd As Object
Dim NBLigne As Long
Dim NBColonne As Integer
Set Fe = Worksheets("Général")
Set Col = New Collection
'défini la plage (colonne C)
With Fe
Set Plage = .Range(.[C1], .[C65536].End(3))
End With
'ajoute le nom des feuilles existantes
'à la collection au cas où elles auraient
'déjà été crées sinon, les supprimer avant
For I = 1 To Worksheets.Count
Col.Add Worksheets(I).Name, Worksheets(I).Name
Next I
'parcour la plage
For Each Cel In Plage
'ajoute le N° à la collection
'ce qui crée une erreur si il existe déjà !
On Error Resume Next
Col.Add Cel.Value, CStr(Cel.Value)
'si ce n'est pas le cas, ajoute une feuille
'la renomme et la place après la feuille "Général"
'et copie la ligne dans la 1ère ligne de la feuille
'normal puisque la feuille vient d'être crée
'elle est donc vierge !!!
If Err.Number = 0 Then
Set FeAjoutee = Worksheets.Add
FeAjoutee.Name = Cel.Value
FeAjoutee.Move , Fe
Cel.EntireRow.Copy FeAjoutee.[A1]
'dans le cas contraire, la feuille existe déjà
'la première ligne vide est alors recherchée
'et la ligne est collée
Else
With Worksheets(CStr(Cel.Value))
Set CelVide = .[A65536].End(3).Offset(1, 0)
End With
Cel.EntireRow.Copy CelVide
End If
Next Cel
'crée une instance de Word
Set AppWord = CreateObject("Word.Application")
'redéfini la plage (ici colonne A pour plus de clarté à cause des
Offsets)
'et recherche le nombre de lignes et colonnes pour la création de la
table
'dans Word
With Fe
Set Plage = .Range(.[A1], .[A65536].End(3))
NBLigne = .Cells.Find("*", .[A1], -4123, , 1, 2).Row
NBColonne = .Cells.Find("*", .[A1], -4123, , 2, 2).Column
End With
'remet I à zéro pour ajout dans la table
I = 0
'supprime un éventuel document avant d'en créer un autre
Kill ThisWorkbook.Path & "Général.doc"
With AppWord
.Visible = True
'ajout d'un nouveau document
Set Doc = .Documents.Add
With Doc
'crée la table
Set TableWd = .Tables.Add(.Range, NBLigne, NBColonne, 1, 1)
With TableWd
'ajoute les valeurs
For Each Cel In Plage
I = I + 1
.Cell(I, 1).Range.Text = Trim(Cel.Text)
.Cell(I, 2).Range.Text = Trim(Cel.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(Cel.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(Cel.Offset(0, 3).Text)
Next Cel
End With
'enregistre dans le même dossier que le classeur
'en lui donnant le nom de la feuille (Général)
.SaveAs ThisWorkbook.Path & "Général.doc"
'ferme le document
'>>>.Close
End With
'ferme Word
'>>>.Quit
End With
Set Cel = Nothing
Set CelVide = Nothing
Set Plage = Nothing
Set Fe = Nothing
Set FeAjoutee = Nothing
Set AppWord = Nothing
Set Doc = Nothing
Set TableWd = Nothing
Set Col = Nothing
End Sub
Hervé.
"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message de
news:
> Salut tout le monde,
>
> j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...) :
> Je cherche à créer une macro qui me permettrait de gagner des heures de
> boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
> (variable) et de colonnes (A - C).
> Exemple :
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
> (A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
>
> Je dois :
> 1- créer un onglet par numéro trouvé en C mais ne pas en créer un
> supplémentaire si le numéro se répète plusieurs fois
> ex : 1 fois onglet "123456" et 1 fois onglet "456789"
>
> 2- copier dans l'onglet correspondant au numéro, les valeurs des x lignes
> de
> "Général"
> onglet "123456"
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
> onglet "456789"
> (A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
>
> 3-recopier les x lignes et colonnes (A:C) de "Général" et les coller dans
> un
> document Word XP "liste.doc" (collage spécial - coller Texte sans mise en
> forme)
>
> Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
> suffisantes pour y arriver, d'où mon SOS.
>
> Merci pour le coup de main.
> --
> Céd / Lausanne
Salut Hervé,
C'est tout simplement FA-BU-LEUX !!! Un grand merci à toi, c'est vraiment
super, j'étais loin de la solution :-( mais heureusement qu'il y a
super-hervé ;-)
Merci.
--
Céd / Lausanne
"Hervé" a écrit :Bonsoir,
Test sur une copie de ton classeur pour voir le résultat. Les valeurs de
la
feuille "Général" sont inscritent dans un tableau dans le document Word
(ce
qui me paraît logique mais adapte si tu veux autre chose). Les
commentaires
sont dans le code (qui fait un peu usine à gaz) pour que tu comprenne le
fonctionnement :
Sub CreerFeuillePuisWord()
Dim Fe As Worksheet
Dim FeAjoutee As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Col As Collection
Dim CelVide As Range
Dim I As Long
'pour Word
Dim AppWord As Object
Dim Doc As Object
Dim TableWd As Object
Dim NBLigne As Long
Dim NBColonne As Integer
Set Fe = Worksheets("Général")
Set Col = New Collection
'défini la plage (colonne C)
With Fe
Set Plage = .Range(.[C1], .[C65536].End(3))
End With
'ajoute le nom des feuilles existantes
'à la collection au cas où elles auraient
'déjà été crées sinon, les supprimer avant
For I = 1 To Worksheets.Count
Col.Add Worksheets(I).Name, Worksheets(I).Name
Next I
'parcour la plage
For Each Cel In Plage
'ajoute le N° à la collection
'ce qui crée une erreur si il existe déjà !
On Error Resume Next
Col.Add Cel.Value, CStr(Cel.Value)
'si ce n'est pas le cas, ajoute une feuille
'la renomme et la place après la feuille "Général"
'et copie la ligne dans la 1ère ligne de la feuille
'normal puisque la feuille vient d'être crée
'elle est donc vierge !!!
If Err.Number = 0 Then
Set FeAjoutee = Worksheets.Add
FeAjoutee.Name = Cel.Value
FeAjoutee.Move , Fe
Cel.EntireRow.Copy FeAjoutee.[A1]
'dans le cas contraire, la feuille existe déjà
'la première ligne vide est alors recherchée
'et la ligne est collée
Else
With Worksheets(CStr(Cel.Value))
Set CelVide = .[A65536].End(3).Offset(1, 0)
End With
Cel.EntireRow.Copy CelVide
End If
Next Cel
'crée une instance de Word
Set AppWord = CreateObject("Word.Application")
'redéfini la plage (ici colonne A pour plus de clarté à cause des
Offsets)
'et recherche le nombre de lignes et colonnes pour la création de
la
table
'dans Word
With Fe
Set Plage = .Range(.[A1], .[A65536].End(3))
NBLigne = .Cells.Find("*", .[A1], -4123, , 1, 2).Row
NBColonne = .Cells.Find("*", .[A1], -4123, , 2, 2).Column
End With
'remet I à zéro pour ajout dans la table
I = 0
'supprime un éventuel document avant d'en créer un autre
Kill ThisWorkbook.Path & "Général.doc"
With AppWord
.Visible = True
'ajout d'un nouveau document
Set Doc = .Documents.Add
With Doc
'crée la table
Set TableWd = .Tables.Add(.Range, NBLigne, NBColonne, 1, 1)
With TableWd
'ajoute les valeurs
For Each Cel In Plage
I = I + 1
.Cell(I, 1).Range.Text = Trim(Cel.Text)
.Cell(I, 2).Range.Text = Trim(Cel.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(Cel.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(Cel.Offset(0, 3).Text)
Next Cel
End With
'enregistre dans le même dossier que le classeur
'en lui donnant le nom de la feuille (Général)
.SaveAs ThisWorkbook.Path & "Général.doc"
'ferme le document
'>>>.Close
End With
'ferme Word
'>>>.Quit
End With
Set Cel = Nothing
Set CelVide = Nothing
Set Plage = Nothing
Set Fe = Nothing
Set FeAjoutee = Nothing
Set AppWord = Nothing
Set Doc = Nothing
Set TableWd = Nothing
Set Col = Nothing
End Sub
Hervé.
"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message
de
news:
> Salut tout le monde,
>
> j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...)
> :
> Je cherche à créer une macro qui me permettrait de gagner des heures de
> boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
> (variable) et de colonnes (A - C).
> Exemple :
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
> (A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
>
> Je dois :
> 1- créer un onglet par numéro trouvé en C mais ne pas en créer un
> supplémentaire si le numéro se répète plusieurs fois
> ex : 1 fois onglet "123456" et 1 fois onglet "456789"
>
> 2- copier dans l'onglet correspondant au numéro, les valeurs des x
> lignes
> de
> "Général"
> onglet "123456"
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
> onglet "456789"
> (A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
>
> 3-recopier les x lignes et colonnes (A:C) de "Général" et les coller
> dans
> un
> document Word XP "liste.doc" (collage spécial - coller Texte sans mise
> en
> forme)
>
> Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
> suffisantes pour y arriver, d'où mon SOS.
>
> Merci pour le coup de main.
> --
> Céd / Lausanne
Salut Hervé,
C'est tout simplement FA-BU-LEUX !!! Un grand merci à toi, c'est vraiment
super, j'étais loin de la solution :-( mais heureusement qu'il y a
super-hervé ;-)
Merci.
--
Céd / Lausanne
"Hervé" a écrit :
Bonsoir,
Test sur une copie de ton classeur pour voir le résultat. Les valeurs de
la
feuille "Général" sont inscritent dans un tableau dans le document Word
(ce
qui me paraît logique mais adapte si tu veux autre chose). Les
commentaires
sont dans le code (qui fait un peu usine à gaz) pour que tu comprenne le
fonctionnement :
Sub CreerFeuillePuisWord()
Dim Fe As Worksheet
Dim FeAjoutee As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Col As Collection
Dim CelVide As Range
Dim I As Long
'pour Word
Dim AppWord As Object
Dim Doc As Object
Dim TableWd As Object
Dim NBLigne As Long
Dim NBColonne As Integer
Set Fe = Worksheets("Général")
Set Col = New Collection
'défini la plage (colonne C)
With Fe
Set Plage = .Range(.[C1], .[C65536].End(3))
End With
'ajoute le nom des feuilles existantes
'à la collection au cas où elles auraient
'déjà été crées sinon, les supprimer avant
For I = 1 To Worksheets.Count
Col.Add Worksheets(I).Name, Worksheets(I).Name
Next I
'parcour la plage
For Each Cel In Plage
'ajoute le N° à la collection
'ce qui crée une erreur si il existe déjà !
On Error Resume Next
Col.Add Cel.Value, CStr(Cel.Value)
'si ce n'est pas le cas, ajoute une feuille
'la renomme et la place après la feuille "Général"
'et copie la ligne dans la 1ère ligne de la feuille
'normal puisque la feuille vient d'être crée
'elle est donc vierge !!!
If Err.Number = 0 Then
Set FeAjoutee = Worksheets.Add
FeAjoutee.Name = Cel.Value
FeAjoutee.Move , Fe
Cel.EntireRow.Copy FeAjoutee.[A1]
'dans le cas contraire, la feuille existe déjà
'la première ligne vide est alors recherchée
'et la ligne est collée
Else
With Worksheets(CStr(Cel.Value))
Set CelVide = .[A65536].End(3).Offset(1, 0)
End With
Cel.EntireRow.Copy CelVide
End If
Next Cel
'crée une instance de Word
Set AppWord = CreateObject("Word.Application")
'redéfini la plage (ici colonne A pour plus de clarté à cause des
Offsets)
'et recherche le nombre de lignes et colonnes pour la création de
la
table
'dans Word
With Fe
Set Plage = .Range(.[A1], .[A65536].End(3))
NBLigne = .Cells.Find("*", .[A1], -4123, , 1, 2).Row
NBColonne = .Cells.Find("*", .[A1], -4123, , 2, 2).Column
End With
'remet I à zéro pour ajout dans la table
I = 0
'supprime un éventuel document avant d'en créer un autre
Kill ThisWorkbook.Path & "Général.doc"
With AppWord
.Visible = True
'ajout d'un nouveau document
Set Doc = .Documents.Add
With Doc
'crée la table
Set TableWd = .Tables.Add(.Range, NBLigne, NBColonne, 1, 1)
With TableWd
'ajoute les valeurs
For Each Cel In Plage
I = I + 1
.Cell(I, 1).Range.Text = Trim(Cel.Text)
.Cell(I, 2).Range.Text = Trim(Cel.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(Cel.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(Cel.Offset(0, 3).Text)
Next Cel
End With
'enregistre dans le même dossier que le classeur
'en lui donnant le nom de la feuille (Général)
.SaveAs ThisWorkbook.Path & "Général.doc"
'ferme le document
'>>>.Close
End With
'ferme Word
'>>>.Quit
End With
Set Cel = Nothing
Set CelVide = Nothing
Set Plage = Nothing
Set Fe = Nothing
Set FeAjoutee = Nothing
Set AppWord = Nothing
Set Doc = Nothing
Set TableWd = Nothing
Set Col = Nothing
End Sub
Hervé.
"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message
de
news: 847F7B06-2980-4C20-954B-81F9F1815C7F@microsoft.com...
> Salut tout le monde,
>
> j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...)
> :
> Je cherche à créer une macro qui me permettrait de gagner des heures de
> boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
> (variable) et de colonnes (A - C).
> Exemple :
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
> (A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
>
> Je dois :
> 1- créer un onglet par numéro trouvé en C mais ne pas en créer un
> supplémentaire si le numéro se répète plusieurs fois
> ex : 1 fois onglet "123456" et 1 fois onglet "456789"
>
> 2- copier dans l'onglet correspondant au numéro, les valeurs des x
> lignes
> de
> "Général"
> onglet "123456"
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
> onglet "456789"
> (A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
>
> 3-recopier les x lignes et colonnes (A:C) de "Général" et les coller
> dans
> un
> document Word XP "liste.doc" (collage spécial - coller Texte sans mise
> en
> forme)
>
> Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
> suffisantes pour y arriver, d'où mon SOS.
>
> Merci pour le coup de main.
> --
> Céd / Lausanne
Salut Hervé,
C'est tout simplement FA-BU-LEUX !!! Un grand merci à toi, c'est vraiment
super, j'étais loin de la solution :-( mais heureusement qu'il y a
super-hervé ;-)
Merci.
--
Céd / Lausanne
"Hervé" a écrit :Bonsoir,
Test sur une copie de ton classeur pour voir le résultat. Les valeurs de
la
feuille "Général" sont inscritent dans un tableau dans le document Word
(ce
qui me paraît logique mais adapte si tu veux autre chose). Les
commentaires
sont dans le code (qui fait un peu usine à gaz) pour que tu comprenne le
fonctionnement :
Sub CreerFeuillePuisWord()
Dim Fe As Worksheet
Dim FeAjoutee As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Col As Collection
Dim CelVide As Range
Dim I As Long
'pour Word
Dim AppWord As Object
Dim Doc As Object
Dim TableWd As Object
Dim NBLigne As Long
Dim NBColonne As Integer
Set Fe = Worksheets("Général")
Set Col = New Collection
'défini la plage (colonne C)
With Fe
Set Plage = .Range(.[C1], .[C65536].End(3))
End With
'ajoute le nom des feuilles existantes
'à la collection au cas où elles auraient
'déjà été crées sinon, les supprimer avant
For I = 1 To Worksheets.Count
Col.Add Worksheets(I).Name, Worksheets(I).Name
Next I
'parcour la plage
For Each Cel In Plage
'ajoute le N° à la collection
'ce qui crée une erreur si il existe déjà !
On Error Resume Next
Col.Add Cel.Value, CStr(Cel.Value)
'si ce n'est pas le cas, ajoute une feuille
'la renomme et la place après la feuille "Général"
'et copie la ligne dans la 1ère ligne de la feuille
'normal puisque la feuille vient d'être crée
'elle est donc vierge !!!
If Err.Number = 0 Then
Set FeAjoutee = Worksheets.Add
FeAjoutee.Name = Cel.Value
FeAjoutee.Move , Fe
Cel.EntireRow.Copy FeAjoutee.[A1]
'dans le cas contraire, la feuille existe déjà
'la première ligne vide est alors recherchée
'et la ligne est collée
Else
With Worksheets(CStr(Cel.Value))
Set CelVide = .[A65536].End(3).Offset(1, 0)
End With
Cel.EntireRow.Copy CelVide
End If
Next Cel
'crée une instance de Word
Set AppWord = CreateObject("Word.Application")
'redéfini la plage (ici colonne A pour plus de clarté à cause des
Offsets)
'et recherche le nombre de lignes et colonnes pour la création de
la
table
'dans Word
With Fe
Set Plage = .Range(.[A1], .[A65536].End(3))
NBLigne = .Cells.Find("*", .[A1], -4123, , 1, 2).Row
NBColonne = .Cells.Find("*", .[A1], -4123, , 2, 2).Column
End With
'remet I à zéro pour ajout dans la table
I = 0
'supprime un éventuel document avant d'en créer un autre
Kill ThisWorkbook.Path & "Général.doc"
With AppWord
.Visible = True
'ajout d'un nouveau document
Set Doc = .Documents.Add
With Doc
'crée la table
Set TableWd = .Tables.Add(.Range, NBLigne, NBColonne, 1, 1)
With TableWd
'ajoute les valeurs
For Each Cel In Plage
I = I + 1
.Cell(I, 1).Range.Text = Trim(Cel.Text)
.Cell(I, 2).Range.Text = Trim(Cel.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(Cel.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(Cel.Offset(0, 3).Text)
Next Cel
End With
'enregistre dans le même dossier que le classeur
'en lui donnant le nom de la feuille (Général)
.SaveAs ThisWorkbook.Path & "Général.doc"
'ferme le document
'>>>.Close
End With
'ferme Word
'>>>.Quit
End With
Set Cel = Nothing
Set CelVide = Nothing
Set Plage = Nothing
Set Fe = Nothing
Set FeAjoutee = Nothing
Set AppWord = Nothing
Set Doc = Nothing
Set TableWd = Nothing
Set Col = Nothing
End Sub
Hervé.
"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message
de
news:
> Salut tout le monde,
>
> j'ai encore besoin d'un coup de main (mais que ferais-je sans vous...)
> :
> Je cherche à créer une macro qui me permettrait de gagner des heures de
> boulot. Dans une feuille "Général", j'ai un certain nombre de lignes
> (variable) et de colonnes (A - C).
> Exemple :
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - aaa (B2) - xxx (C2) - 456789 (D2) - www
> (A100) - zzz (B100) - ttt (C100) -123456 (D100) - fff
>
> Je dois :
> 1- créer un onglet par numéro trouvé en C mais ne pas en créer un
> supplémentaire si le numéro se répète plusieurs fois
> ex : 1 fois onglet "123456" et 1 fois onglet "456789"
>
> 2- copier dans l'onglet correspondant au numéro, les valeurs des x
> lignes
> de
> "Général"
> onglet "123456"
> (A1) - aaa (B1) - bbb (C1) - 123456 (D1) - ddd
> (A2) - zzz (B2) - ttt (C2) - 123456 (D2) - fff
> onglet "456789"
> (A1) - aaa (B1) - xxx (C1) - 456789 (D1) - www
>
> 3-recopier les x lignes et colonnes (A:C) de "Général" et les coller
> dans
> un
> document Word XP "liste.doc" (collage spécial - coller Texte sans mise
> en
> forme)
>
> Comme vous le voyez... yaka...;-) Mes connaissances en VBA ne sont pas
> suffisantes pour y arriver, d'où mon SOS.
>
> Merci pour le coup de main.
> --
> Céd / Lausanne