J=92aimerais recopier les valeurs Bx:Fx du classeur1 dans la colonne du moi=
s pass=E9 du classeur2.
Pour le moment, j=92ai une erreur pour ouvrir le classeur2 (LHCF.xls)
Le r=E9sultat voulu est dans feuil2 du classeur2.
'-----------------------------------------------------------------------
Sub Extract()
Dim WB1 As Workbook, WB2 As Workbook
Dim fMonth As Range, mPlg As Range, mF$
Dim obnPlg As Range, fnObj As Range, obPlg As Range, fObj As Range
Dim tb() As Variant, i%, Chn$
Set WB1 =3D Workbooks("TQ (1).xls")
Set WB2 =3D Workbooks.Open("LHCF.xls")
'-- Mois pass=E9
mF =3D Format(DateAdd("m", -1, Date), "mmm")
With WB1.Sheets("feuil1")
'-- Tableaux contenant les noms (Col H) et leurs =E9quivalences en =
objet (Col I)
tb =3D .Range("H2:I" & [H65000].End(xlUp).Row).Value
'-- Plage des objets dans classeur1
Set obPlg =3D .Range(.Cells(2, 1), .Cells(.Cells.Rows.Count, 1).End=
(xlUp))
End With
With WB2.Sheets("feuil1")
'-- Plage des noms des objets dans classeur2
Set obnPlg =3D .Range(.Cells(9, 1), .Cells(.Cells.Rows.Count, 1).En=
d(xlUp) _
.Offset(1, 0)) ' Pour faire en=
trer la derniere cellule fusionn=E9e
'-- Plage des mois dans classeur2
Set mPlg =3D .Range(.Cells(7, 1), .Cells(7, 256).End(xlToLeft))
End With
'-- Recherche du mois pass=E9
Set fMonth =3D mPlg.Find(mF)
For i =3D LBound(tb) To UBound(tb)
If Len(tb(i, 1)) > 0 Then
Set fnObj =3D obnPlg.Find(tb(i, 1), LookIn:=3DxlValues, LookAt:=
=3DxlPart)
If Not fnObj Is Nothing Then
Set fObj =3D obPlg.Find(tb(i, 2), LookIn:=3DxlValues, LookA=
t:=3DxlPart)
If Not fObj Is Nothing Then
'-- Si l'objet trouv=E9 se termine par un D
'-- On commence l'=E9criture juste =E0 la ligne de fnOb=
j dans classeur2
Chn =3D WB1.Sheets("feuil1").Range("A" & fObj.Row)
If Mid(Chn, Len(Chn), 1) =3D "D" Then
WB2.Sheets("feuil1").Cells(fnObj.Row, fMonth.Column=
).Resize(4, 1).Value =3D Application.Transpose(WB1.Sheets("feuil1").Range(C=
ells(fObj.Row, 2), Cells(fObj.Row, 7)).Value)
'-- Si l'objet trouv=E9 se termine par un A
'-- On commence l'=E9criture =E0 la ligne de fnObj + 8 =
lignes en bas dans classeur2
ElseIf Mid(Chn, Len(Chn), 1) =3D "A" Then
WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Co=
lumn).Resize(4, 1).Value =3D Application.Transpose(WB1.Sheets("feuil1").Ran=
ge(Cells(fObj.Row, 2), Cells(fObj.Row, 7)).Value)
End If
End If
End If
End If
Next i
Set WB1 =3D Nothing: Set WB2 =3D Nothing: Set mPlg =3D Nothing
Set obnPlg =3D Nothing: Set fnObj =3D Nothing: Set obPlg =3D Nothing: S=
et fObj =3D Nothing
End Sub
'-------------------------------------------------------------
Lors de la vérification des cellules contenant un vide ou un zéro dans classeur1, j'ai modifié les valeurs dans la feuille en mettant de (0), av ant de les copier dans le deuxième classeur.
Y a-t-il une possibilité pour modifier le code et mettre des zéros dans le deuxième classeur sans modification dans le classeur1 ?
'-------------------------------------------- '-- Si les QS ou QT d'un objet sont nulles ou vides, alors mettre '-- les NCS=0, TRF=0, QS=0.00, QT=0.0 If Range("E" & fObj.Row) = 0 Or Range("E" & fObj.Row) = "" Or _ Range("F" & fObj.Row) = 0 Or Range("F" & fObj.Row) = "" Then _ Range("C" & fObj.Row) = 0: Range("D" & fObj.Row) = 0: Range("E" & fObj. Row) = 0: Range("F" & fObj.Row) = 0
'-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1 WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Column).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(Cells(fObj.Row, 2), C ells(fObj.Row, 6)).Value)
Lors de la vérification des cellules contenant un vide ou un zéro dans classeur1, j'ai modifié les valeurs dans la feuille en mettant de (0), av ant de les copier dans le deuxième classeur.
Y a-t-il une possibilité pour modifier le code et mettre des zéros dans le deuxième classeur sans modification dans le classeur1 ?
'--------------------------------------------
'-- Si les QS ou QT d'un objet sont nulles ou vides, alors mettre
'-- les NCS=0, TRF=0, QS=0.00, QT=0.0
If Range("E" & fObj.Row) = 0 Or Range("E" & fObj.Row) = "" Or _
Range("F" & fObj.Row) = 0 Or Range("F" & fObj.Row) = "" Then _
Range("C" & fObj.Row) = 0: Range("D" & fObj.Row) = 0: Range("E" & fObj. Row) = 0: Range("F" & fObj.Row) = 0
'-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1
WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Column).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(Cells(fObj.Row, 2), C ells(fObj.Row, 6)).Value)
Lors de la vérification des cellules contenant un vide ou un zéro dans classeur1, j'ai modifié les valeurs dans la feuille en mettant de (0), av ant de les copier dans le deuxième classeur.
Y a-t-il une possibilité pour modifier le code et mettre des zéros dans le deuxième classeur sans modification dans le classeur1 ?
'-------------------------------------------- '-- Si les QS ou QT d'un objet sont nulles ou vides, alors mettre '-- les NCS=0, TRF=0, QS=0.00, QT=0.0 If Range("E" & fObj.Row) = 0 Or Range("E" & fObj.Row) = "" Or _ Range("F" & fObj.Row) = 0 Or Range("F" & fObj.Row) = "" Then _ Range("C" & fObj.Row) = 0: Range("D" & fObj.Row) = 0: Range("E" & fObj. Row) = 0: Range("F" & fObj.Row) = 0
'-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1 WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Column).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(Cells(fObj.Row, 2), C ells(fObj.Row, 6)).Value)
Tu parles de la même chose ou tu es parti sur autre chose ? Daniel
Bonsoir Daniel,
Lors de la vérification des cellules contenant un vide ou un zéro dans classeur1, j'ai modifié les valeurs dans la feuille en mettant de (0), avant de les copier dans le deuxième classeur.
Y a-t-il une possibilité pour modifier le code et mettre des zéros dans le deuxième classeur sans modification dans le classeur1 ?
'-------------------------------------------- '-- Si les QS ou QT d'un objet sont nulles ou vides, alors mettre '-- les NCS=0, TRF=0, QS=0.00, QT=0.0 If Range("E" & fObj.Row) = 0 Or Range("E" & fObj.Row) = "" Or _ Range("F" & fObj.Row) = 0 Or Range("F" & fObj.Row) = "" Then _ Range("C" & fObj.Row) = 0: Range("D" & fObj.Row) = 0: Range("E" & fObj.Row) = 0: Range("F" & fObj.Row) = 0
'-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1 WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Column).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(Cells(fObj.Row, 2), Cells(fObj.Row, 6)).Value)
Tu parles de la même chose ou tu es parti sur autre chose ?
Daniel
Bonsoir Daniel,
Lors de la vérification des cellules contenant un vide ou un zéro dans
classeur1, j'ai modifié les valeurs dans la feuille en mettant de (0), avant
de les copier dans le deuxième classeur.
Y a-t-il une possibilité pour modifier le code et mettre des zéros dans le
deuxième classeur sans modification dans le classeur1 ?
'--------------------------------------------
'-- Si les QS ou QT d'un objet sont nulles ou vides, alors mettre
'-- les NCS=0, TRF=0, QS=0.00, QT=0.0
If Range("E" & fObj.Row) = 0 Or Range("E" & fObj.Row) = "" Or _
Range("F" & fObj.Row) = 0 Or Range("F" & fObj.Row) = "" Then _
Range("C" & fObj.Row) = 0: Range("D" & fObj.Row) = 0: Range("E" & fObj.Row) =
0: Range("F" & fObj.Row) = 0
'-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1
WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Column).Resize(5, 1).Value =
Application.Transpose(WB1.Sheets("feuil1").Range(Cells(fObj.Row, 2),
Cells(fObj.Row, 6)).Value)
Tu parles de la même chose ou tu es parti sur autre chose ? Daniel
Bonsoir Daniel,
Lors de la vérification des cellules contenant un vide ou un zéro dans classeur1, j'ai modifié les valeurs dans la feuille en mettant de (0), avant de les copier dans le deuxième classeur.
Y a-t-il une possibilité pour modifier le code et mettre des zéros dans le deuxième classeur sans modification dans le classeur1 ?
'-------------------------------------------- '-- Si les QS ou QT d'un objet sont nulles ou vides, alors mettre '-- les NCS=0, TRF=0, QS=0.00, QT=0.0 If Range("E" & fObj.Row) = 0 Or Range("E" & fObj.Row) = "" Or _ Range("F" & fObj.Row) = 0 Or Range("F" & fObj.Row) = "" Then _ Range("C" & fObj.Row) = 0: Range("D" & fObj.Row) = 0: Range("E" & fObj.Row) = 0: Range("F" & fObj.Row) = 0
'-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1 WB2.Sheets("feuil1").Cells(fnObj.Row + 8, fMonth.Column).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(Cells(fObj.Row, 2), Cells(fObj.Row, 6)).Value)
Tu parles de la même chose ou tu es parti sur autre chose ?
Non je parlais, du cas ou les QS ou QT est égal à zéro ou est vide da ns WB1.
Pour le moment je mets les cellules de B à F à zéro dans la feuille 1 de WB1 pour ce cas.
Puis je les copie dans le WB2.
J'aimerais trouver une alternative pour ne pas modifier ces valeurs sur la feuille1 de WB1, tout en copiant les 4 valeurs (NCS=0, TRF=0, QS=0 et QT=0) dans WB2 après affectation des zéros.
Tu parles de la même chose ou tu es parti sur autre chose ?
Non je parlais, du cas ou les QS ou QT est égal à zéro ou est vide da ns WB1.
Pour le moment je mets les cellules de B à F à zéro dans la feuille 1 de WB1 pour ce cas.
Puis je les copie dans le WB2.
J'aimerais trouver une alternative pour ne pas modifier ces valeurs sur la feuille1 de WB1, tout en copiant les 4 valeurs (NCS=0, TRF=0, QS=0 et QT=0) dans WB2 après affectation des zéros.
Tu parles de la même chose ou tu es parti sur autre chose ?
Non je parlais, du cas ou les QS ou QT est égal à zéro ou est vide da ns WB1.
Pour le moment je mets les cellules de B à F à zéro dans la feuille 1 de WB1 pour ce cas.
Puis je les copie dans le WB2.
J'aimerais trouver une alternative pour ne pas modifier ces valeurs sur la feuille1 de WB1, tout en copiant les 4 valeurs (NCS=0, TRF=0, QS=0 et QT=0) dans WB2 après affectation des zéros.
h2so4
tu copies tes valeurs en WB2, puis tu fais les remplacements des cellules v ides par zéro dans WB2 dans les cellules qui t'intéressent.
On Tuesday, June 12, 2012 10:57:01 PM UTC+2, Apitos wrote:
> Tu parles de la même chose ou tu es parti sur autre chose ?
Non je parlais, du cas ou les QS ou QT est égal à zéro ou est vide dans WB1.
Pour le moment je mets les cellules de B à F à zéro dans la feuille 1 de WB1 pour ce cas.
Puis je les copie dans le WB2.
J'aimerais trouver une alternative pour ne pas modifier ces valeurs sur l a feuille1 de WB1, tout en copiant les 4 valeurs (NCS=0, TRF=0, QS=0 et QT=0) dans WB2 après affectation des zéros.
tu copies tes valeurs en WB2, puis tu fais les remplacements des cellules v ides par zéro dans WB2 dans les cellules qui t'intéressent.
On Tuesday, June 12, 2012 10:57:01 PM UTC+2, Apitos wrote:
> Tu parles de la même chose ou tu es parti sur autre chose ?
Non je parlais, du cas ou les QS ou QT est égal à zéro ou est vide dans WB1.
Pour le moment je mets les cellules de B à F à zéro dans la feuille 1 de WB1 pour ce cas.
Puis je les copie dans le WB2.
J'aimerais trouver une alternative pour ne pas modifier ces valeurs sur l a feuille1 de WB1, tout en copiant les 4 valeurs (NCS=0, TRF=0, QS=0 et QT=0) dans WB2 après affectation des zéros.
tu copies tes valeurs en WB2, puis tu fais les remplacements des cellules v ides par zéro dans WB2 dans les cellules qui t'intéressent.
On Tuesday, June 12, 2012 10:57:01 PM UTC+2, Apitos wrote:
> Tu parles de la même chose ou tu es parti sur autre chose ?
Non je parlais, du cas ou les QS ou QT est égal à zéro ou est vide dans WB1.
Pour le moment je mets les cellules de B à F à zéro dans la feuille 1 de WB1 pour ce cas.
Puis je les copie dans le WB2.
J'aimerais trouver une alternative pour ne pas modifier ces valeurs sur l a feuille1 de WB1, tout en copiant les 4 valeurs (NCS=0, TRF=0, QS=0 et QT=0) dans WB2 après affectation des zéros.
Apitos
Bonsoir heso4,
tu copies tes valeurs en WB2, puis tu fais les remplacements des cellules vides par zéro dans WB2 dans les cellules qui t'intéressent.
Voila mon code :
'----------------------------------------------------- '-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1 WB2.Sheets("feuil1").Cells(fnObj.Row, fMonth.Column ).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(C ells(fObj.Row, 2), Cells(fObj.Row, 6)).Value)
'-- Si les QS ou QT d'un objet sont nulles ou vides , alors mettre '-- les NCS=0, TRF=0.00, QS=0.00, QT=0.00 With WB1.Sheets("feuil1") If .Range("E" & fObj.Row) = 0 Or .Range("F" & fObj.Row) = "" Then _ WB2.Sheets("feuil1").Cells(fnObj.Row + 1, fM onth.Column).Resize(4, 1).Value = 0 End With
'-- Formater les deux dernières valeurs en 0.00 With WB2.Sheets("feuil1") .Cells(fnObj.Row + 3, fMonth.Column).Value = _ .Cells(fnObj.Row + 3, fMonth.Column) * 100 .Cells(fnObj.Row + 4, fMonth.Column).Value = _ .Cells(fnObj.Row + 4, fMonth.Column) * 100 .Cells(fnObj.Row + 3, fMonth.Column).Resize(2). NumberFormat = "0.00" End With '-----------------------------------------------------
Bonsoir heso4,
tu copies tes valeurs en WB2, puis tu fais les remplacements des cellules vides par zéro dans WB2 dans les cellules qui t'intéressent.
Voila mon code :
'-----------------------------------------------------
'-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1
WB2.Sheets("feuil1").Cells(fnObj.Row, fMonth.Column ).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(C ells(fObj.Row, 2), Cells(fObj.Row, 6)).Value)
'-- Si les QS ou QT d'un objet sont nulles ou vides , alors mettre
'-- les NCS=0, TRF=0.00, QS=0.00, QT=0.00
With WB1.Sheets("feuil1")
If .Range("E" & fObj.Row) = 0 Or .Range("F" & fObj.Row) = "" Then _
WB2.Sheets("feuil1").Cells(fnObj.Row + 1, fM onth.Column).Resize(4, 1).Value = 0
End With
'-- Formater les deux dernières valeurs en 0.00
With WB2.Sheets("feuil1")
.Cells(fnObj.Row + 3, fMonth.Column).Value = _
.Cells(fnObj.Row + 3, fMonth.Column) * 100
.Cells(fnObj.Row + 4, fMonth.Column).Value = _
.Cells(fnObj.Row + 4, fMonth.Column) * 100
.Cells(fnObj.Row + 3, fMonth.Column).Resize(2). NumberFormat = "0.00"
End With
'-----------------------------------------------------
tu copies tes valeurs en WB2, puis tu fais les remplacements des cellules vides par zéro dans WB2 dans les cellules qui t'intéressent.
Voila mon code :
'----------------------------------------------------- '-- Copier les 5 valeurs de l'objet dans WB2 depuis WB1 WB2.Sheets("feuil1").Cells(fnObj.Row, fMonth.Column ).Resize(5, 1).Value = Application.Transpose(WB1.Sheets("feuil1").Range(C ells(fObj.Row, 2), Cells(fObj.Row, 6)).Value)
'-- Si les QS ou QT d'un objet sont nulles ou vides , alors mettre '-- les NCS=0, TRF=0.00, QS=0.00, QT=0.00 With WB1.Sheets("feuil1") If .Range("E" & fObj.Row) = 0 Or .Range("F" & fObj.Row) = "" Then _ WB2.Sheets("feuil1").Cells(fnObj.Row + 1, fM onth.Column).Resize(4, 1).Value = 0 End With
'-- Formater les deux dernières valeurs en 0.00 With WB2.Sheets("feuil1") .Cells(fnObj.Row + 3, fMonth.Column).Value = _ .Cells(fnObj.Row + 3, fMonth.Column) * 100 .Cells(fnObj.Row + 4, fMonth.Column).Value = _ .Cells(fnObj.Row + 4, fMonth.Column) * 100 .Cells(fnObj.Row + 3, fMonth.Column).Resize(2). NumberFormat = "0.00" End With '-----------------------------------------------------
