Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé, dans
les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et certains
produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé, dans
les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et certains
produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé, dans
les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et certains
produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Le message est l'indice n'appartient pas à la selection et pourtant la feuil5
existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5 ne
fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé, dans
les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et certains
produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Le message est l'indice n'appartient pas à la selection et pourtant la feuil5
existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5 ne
fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé, dans
les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et certains
produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Le message est l'indice n'appartient pas à la selection et pourtant la feuil5
existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5 ne
fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé, dans
les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et certains
produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à tester
la macro.
DanielLe message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à tester
la macro.
Daniel
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à tester
la macro.
DanielLe message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
lorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
lorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
lorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Oups de ma faute, une malencontreuse ' s'était glissée dans
Set SourceA = Sheets("Feuil5") juste avant le 5.Donc cela ne plante plus mais
dans le classeur de destination aucune données et ce malgré la recommandation
d'Isabelle.
Donc je veux bien que tu me postes tes classeurs exemple.
Merci
Pascal
"Daniel.C" a écrit dans le message de news:La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à tester
la macro.
DanielLe message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Oups de ma faute, une malencontreuse ' s'était glissée dans
Set SourceA = Sheets("Feuil5") juste avant le 5.Donc cela ne plante plus mais
dans le classeur de destination aucune données et ce malgré la recommandation
d'Isabelle.
Donc je veux bien que tu me postes tes classeurs exemple.
Merci
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
uzpCSOCwJHA.4452@TK2MSFTNGP04.phx.gbl...
La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à tester
la macro.
Daniel
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Oups de ma faute, une malencontreuse ' s'était glissée dans
Set SourceA = Sheets("Feuil5") juste avant le 5.Donc cela ne plante plus mais
dans le classeur de destination aucune données et ce malgré la recommandation
d'Isabelle.
Donc je veux bien que tu me postes tes classeurs exemple.
Merci
Pascal
"Daniel.C" a écrit dans le message de news:La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à tester
la macro.
DanielLe message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
lorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
lorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
lorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si Feuil5
ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le 3éme
classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de news:
%Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) + c.Offset(,
2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien sûr
s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un nom
de Gamme de produits et en ColB le nom du produit. Une gamme peu
contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme unique
regroupant toutes les données sachant que certaines gammes et
certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les 290
lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Bonjour Isabelle.
J'aurais dû commenter mon code...
La ligne :
Set SourceA = Sheets("Feuil5")
s'applique au classeur (source) que l'on vient d'ouvrir.
Daniellorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :Le message est l'indice n'appartient pas à la selection et pourtant
la feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de
news:Telle que je l'ai écrite, les résultats s'inscrivent dans un
nouveau classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si
Feuil5 ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le
3éme classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de
news: %Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas
précisé, dans les colonnes adjacentes c-->f j'ai des Qtés qui
doivent bien sûr s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA
un nom de Gamme de produits et en ColB le nom du produit. Une
gamme peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme
unique regroupant toutes les données sachant que certaines
gammes et certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les
290 lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Bonjour Isabelle.
J'aurais dû commenter mon code...
La ligne :
Set SourceA = Sheets("Feuil5")
s'applique au classeur (source) que l'on vient d'ouvrir.
Daniel
lorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :
Le message est l'indice n'appartient pas à la selection et pourtant
la feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de
news: OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un
nouveau classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si
Feuil5 ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le
3éme classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de
news: %23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas
précisé, dans les colonnes adjacentes c-->f j'ai des Qtés qui
doivent bien sûr s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA
un nom de Gamme de produits et en ColB le nom du produit. Une
gamme peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme
unique regroupant toutes les données sachant que certaines
gammes et certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les
290 lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
Bonjour Isabelle.
J'aurais dû commenter mon code...
La ligne :
Set SourceA = Sheets("Feuil5")
s'applique au classeur (source) que l'on vient d'ouvrir.
Daniellorsque l'on ajoute un classeur, c'est ce dernier qui est actif,
il faut donc revenir au classeur d'avant, avant la commande
Set SourceA = Sheets("Feuil5")
isabelle
pb a écrit :Le message est l'indice n'appartient pas à la selection et pourtant
la feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de
news:Telle que je l'ai écrite, les résultats s'inscrivent dans un
nouveau classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si
Feuil5 ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le
3éme classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de
news: %Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas
précisé, dans les colonnes adjacentes c-->f j'ai des Qtés qui
doivent bien sûr s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA
un nom de Gamme de produits et en ColB le nom du produit. Une
gamme peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme
unique regroupant toutes les données sachant que certaines
gammes et certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les
290 lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
http://www.cijoint.fr/cjlink.php?file=cj200904/cijghYL3jj.xls
http://www.cijoint.fr/cjlink.php?file=cj200904/cijn84hZkN.xls
DanielOups de ma faute, une malencontreuse ' s'était glissée dans
Set SourceA = Sheets("Feuil5") juste avant le 5.Donc cela ne plante plus
mais dans le classeur de destination aucune données et ce malgré la
recommandation d'Isabelle.
Donc je veux bien que tu me postes tes classeurs exemple.
Merci
Pascal
"Daniel.C" a écrit dans le message de news:La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à
tester la macro.
DanielLe message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si
Feuil5 ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le
3éme classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de
news: %Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien
sûr s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme
unique regroupant toutes les données sachant que certaines gammes
et certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les
290 lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
http://www.cijoint.fr/cjlink.php?file=cj200904/cijghYL3jj.xls
http://www.cijoint.fr/cjlink.php?file=cj200904/cijn84hZkN.xls
Daniel
Oups de ma faute, une malencontreuse ' s'était glissée dans
Set SourceA = Sheets("Feuil5") juste avant le 5.Donc cela ne plante plus
mais dans le classeur de destination aucune données et ce malgré la
recommandation d'Isabelle.
Donc je veux bien que tu me postes tes classeurs exemple.
Merci
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
uzpCSOCwJHA.4452@TK2MSFTNGP04.phx.gbl...
La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à
tester la macro.
Daniel
Le message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
OkJ23FCwJHA.5836@TK2MSFTNGP06.phx.gbl...
Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si
Feuil5 ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
Daniel
Merci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le
3éme classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de
news: %23DizohBwJHA.1492@TK2MSFTNGP03.phx.gbl...
Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
Daniel
Merci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien
sûr s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OxYDeLAwJHA.5836@TK2MSFTNGP06.phx.gbl...
Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :
Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme
unique regroupant toutes les données sachant que certaines gammes
et certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les
290 lignes.
Quelqu'un a t'il une idée??
Merci
Pascal
http://www.cijoint.fr/cjlink.php?file=cj200904/cijghYL3jj.xls
http://www.cijoint.fr/cjlink.php?file=cj200904/cijn84hZkN.xls
DanielOups de ma faute, une malencontreuse ' s'était glissée dans
Set SourceA = Sheets("Feuil5") juste avant le 5.Donc cela ne plante plus
mais dans le classeur de destination aucune données et ce malgré la
recommandation d'Isabelle.
Donc je veux bien que tu me postes tes classeurs exemple.
Merci
Pascal
"Daniel.C" a écrit dans le message de news:La ligne :
Set SourceA = Sheets("Feuil5")
fait référence à la feuille contenant les données source d'un des deux
classeurs.
Pour plus de clarté, je peux poster les classeurs qui m'on servi à
tester la macro.
DanielLe message est l'indice n'appartient pas à la selection et pourtant la
feuil5 existe bien. Je dois merdouiller quelque part.
"Daniel.C" a écrit dans le message de news:Telle que je l'ai écrite, les résultats s'inscrivent dans un nouveau
classeur créé par :
Workbooks.Add 1
Par contre je ne vois pas ce qui peut provoquer l'erreur, sauf si
Feuil5 ne fait pas partie du classeur "S:Atlantic Santécr2009.xls".
Quel est le message d'erreur ?
DanielMerci Daniel,
J'ai adapté les différents chemin et j'ai collé ton module dans le
3éme classeur de destination
J'ai un soucis sur la dernière ligne de ce bout de code
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "S:Atlantic Santécr2009.xls"
Set SourceA = Sheets("Feuil5")
Débogage sur : Set SourceA = Sheets("Feuil5")
Pascal
"Daniel.C" a écrit dans le message de
news: %Bonjour.
Essaie :
Sub test()
Dim SourceA As Worksheet, SourceB As Worksheet, Dico As Object
Dim c As Range, Sh As Worksheet, Ctr As Long, Ligne
Set Dico = CreateObject("Scripting.dictionary")
Workbooks.Add 1
Set Sh = ActiveSheet
Workbooks.Open "e:donneesdanielmpfeSourceA.xls"
Set SourceA = Sheets("Feuil1")
With SourceA
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c, Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
Workbooks.Open "e:donneesdanielmpfeSourceB.xls"
Set SourceB = Sheets("Feuil1")
With SourceB
For Each c In Range(.[A1], .[A65000].End(xlUp))
If Not Dico.exists(c.Offset(, 1).Value) Then
Dico.Add c.Offset(, 1).Value, c.Offset(, 1).Value
Ctr = Ctr + 1
Sh.Cells(Ctr, 1) = c
Sh.Cells(Ctr, 2) = c.Offset(, 1)
Sh.Cells(Ctr, 3) = c.Offset(, 2)
Else
Ligne = Application.Match(c.Offset(, 1), Sh.[B:B], 0)
If IsNumeric(Ligne) Then
Sh.Cells(Ligne, 3) = Sh.Cells(Ligne, 3) +
c.Offset(, 2)
End If
End If
Next c
End With
ActiveWorkbook.Close False
End Sub
Cordialement.
DanielMerci de ta solution,
C'est ce que j'ai fais le seul truc mais je ne l'avais pas précisé,
dans les colonnes adjacentes c-->f j'ai des Qtés qui doivent bien
sûr s'additionner sur le classeur 3 au même endroit
Merci
Pascal
"LSteph" a écrit dans le message de news:Bonjour,
En trois coup les gros:
Dans classeur3 colles tes données A:B.. du 2008
puis juste en dessous tes données A:B..n du 2009
Sélectionne le tout Données Filtre élaboré
coche sans doublons et pour Copier vers un autre emplacement
choisis la cellule D1 par exemple un peu plus loin et zou extrais.
Tu obtiens la liste sans doublons
Plus qu'à supprimer les colonnes A:C devenues inutiles.
--
lSteph
pb a écrit :Bonjour,
J'ai deux fichiers 2008 et 2009 avec pour chacun d'eux en ColA un
nom de Gamme de produits et en ColB le nom du produit. Une gamme
peu contenir X Produits
A partir de ces deux fichiers, je dois en faire un troisiéme
unique regroupant toutes les données sachant que certaines gammes
et certains produits, ne sont pas communs au deux.
Sur 50 lignes je le faisais à la main, le souci là ce sont les
290 lignes.
Quelqu'un a t'il une idée??
Merci
Pascal