Garder la formule "DECALER"

[la croisée des pains]

🙂 bonjour à tous
dans une feuille "Vente" j'ai une formule en (b9:b48) =
DECALER(U8;0;JOURSEM($A$7;2))


quand j'utilise le code qui suit j'aimerais garder la formule mais cela s'éfface toujours.Quel est le code pour la garder? Merci de votre aide.

Sub Imprim_Vente()
Dim Tabtemp As Variant
Dim L As Byte
Dim c As Byte
Dim Derlgn As Integer
Dim Cell As Range
Dim Ws_1 As Worksheet
Dim Date_Transfert As String
Dim Libelle_Transfert As String

Set Ws_1 = Worksheets("RécapVente")
Application.ScreenUpdating = False
With Worksheets("Vente")
Date_Transfert = Format(.Range("B7"), " dddd dd mmmm yyyy")
Libelle_Transfert = (.Range("B8"))
Tabtemp = .Range(.Cells(9, 2), .Cells(.Cells(8, 2).End(xlDown).Row, .Cells(8, 2).End(xlToRight).Column)).Value
If Tabtemp(LBound(Tabtemp, 1), 1) = "" Then Exit Sub

.Range(.Cells(9, 2), .Cells(.Cells(9, 2).End(xlDown).Row, .Cells(8, 2).End(xlToRight).Column)).ClearContents
End With
With Ws_1
For L = 1 To UBound(Tabtemp, 1)
Derlgn = .Range("A65536").End(xlUp).Row + 1
.Cells(Derlgn, 1) = Date_Transfert
.Cells(Derlgn, 3) = Libelle_Transfert
For c = 1 To UBound(Tabtemp, 2)
If c = 1 Then
.Cells(Derlgn, 1 + c) = Tabtemp(L, c)
Else
.Cells(Derlgn, 2 + c) = Tabtemp(L, c)
End If
Next
Next
End With
Tabtemp = ""
Application.ScreenUpdating = True

End Sub

 

[Bernard_XLD]

Re : Garder la formule "DECALER"

Bonjour la croisée des pains, le forum

il y a plusieurs lignes à modifier, donnes une feuille exemple car il y a plusieurs façons d'interpréter ta demande et donc plusieurs façons de modifier le code.

Cordialement, A+

 

[la croisée des pains]

Re : Garder la formule "DECALER"

bonjour le forum,
bonjour Yeahou

voici le fichier

merci de votre aide

 

[Bernard_XLD]

Re : Garder la formule "DECALER"

Re

modifie cette ligne
.Range(.Cells(9, 2), .Cells(.Cells(9, 2).End(xlDown).Row, .Cells(8, 2).End(xlToRight).Column)).ClearContents

en
.Range(.Cells(9, 3), .Cells(.Cells(9, 2).End(xlDown).Row, .Cells(8, 2).End(xlToRight).Column)).ClearContents

méfie toi, sur tes boutons, les chemins des macros me parraissent mal définis, ils ciblent en dur un répertoire temporaire et un autre fichier
'C:\Temp\essai\New Version_2 (version 2).xls'!Imprim_Vente

A+

 

[la croisée des pains]

Re : Garder la formule "DECALER"

re,
merci de ton aide

je ne veux pas abuser mais au moment du transfert les lignes total s'éffacent aussi (il faut les garder) et toutes mes données ne se transfèrent pas
il doit avoir une eereur dans mon code.
donc merci si tu as 2 mn d'y jeter un coup d'oeil

ps: pour la cible du fichier temporaire c'est normal j'ai une copie du fichier et je n'ai pas modifier touts les codes

laurent

 

[Bernard_XLD]

Re : Garder la formule "DECALER"

Re

1-Pour effacer, remplaces la ligne
.Range(.Cells(9, 2), .Cells(.Cells(9, 2).End(xlDown).Row, .Cells(8, 2).End(xlToRight).Column)).ClearContents

par ces deux lignes
.Range(.Cells(9, 3), .Cells(.Cells(8, 2).Row + (((.Cells(9, 2).End(xlDown).Row - .Cells(8, 2).Row) - 2) / 2), .Cells(8, 2).End(xlToRight).Column)).ClearContents
.Range(.Cells(.Cells(9, 3).Row + ((.Cells(9, 2).End(xlDown).Row - .Cells(8, 2).Row) / 2), 3), .Cells(.Cells(9, 2).End(xlDown).Row - 1, .Cells(8, 2).End(xlToRight).Column)).ClearContents

2-pour ton erreur, entres une valeur quelconque en B8 sinon ton code ne peut pas fonctionner


A+

 

[la croisée des pains]

Re : Garder la formule "DECALER"

re,
ok ca marche
ptit probl
lors du transfert , la boucle prends la ligne total et indique les clients qui n'ont pas de données.
peut t'on modifier le boucle pour qu"elle ne prenne en compte seulement les clients mouvementées et ne pas mettre la ligne total lorsde se transfert.

merci encore de ton aide

laurent

 

[Bernard_XLD]

Re : Garder la formule "DECALER"

Re

pendant que j'y étais, j'ai un peu modifié
la macro traite les vendus et les invendus en même temps, par contre la cellule B8 ne doit pas être vide mais elle n'est plus utilisée pour spécifier vendu invendu

A+

Sub Imprim_Vente()

Dim Tabtemp As Variant
Dim L As Byte
Dim C As Byte
Dim Derlgn As Integer
Dim Cell As Range
Dim Ws_1 As Worksheet
Dim Date_Transfert As String
Dim Libelle_Transfert As String
Dim Test As Boolean

Set Ws_1 = Worksheets("RécapVente")
Application.ScreenUpdating = False
With Worksheets("Vente")
Date_Transfert = Format(.Range("B7"), " dddd dd mmmm yyyy")
Libelle_Transfert = "Vendu"
Tabtemp = .Range(.Cells(9, 2), .Cells(.Cells(8, 2).End(xlDown).Row, .Cells(8, 2).End(xlToRight).Column)).Value

If Tabtemp(LBound(Tabtemp, 1), 1) = "" Then Exit Sub
.Range(.Cells(9, 3), .Cells(.Cells(8, 2).Row + (((.Cells(9, 2).End(xlDown).Row - .Cells(8, 2).Row) - 2) / 2), .Cells(8, 2).End(xlToRight).Column)).ClearContents
.Range(.Cells(.Cells(9, 3).Row + ((.Cells(9, 2).End(xlDown).Row - .Cells(8, 2).Row) / 2), 3), .Cells(.Cells(9, 2).End(xlDown).Row - 1, .Cells(8, 2).End(xlToRight).Column)).ClearContents
End With
With Ws_1
For L = 1 To UBound(Tabtemp, 1)
If Not Left(Tabtemp(L, 1), 5) = "TOTAL" Then
Test = False
For C = 2 To UBound(Tabtemp, 2)
If Not (Tabtemp(L, C) = "") Then Test = True
Next
If Test = True Then
Derlgn = .Range("A65536").End(xlUp).Row + 1
.Cells(Derlgn, 1) = Date_Transfert
.Cells(Derlgn, 3) = Libelle_Transfert
For C = 1 To UBound(Tabtemp, 2)
If C = 1 Then
.Cells(Derlgn, 1 + C) = Tabtemp(L, C)
Else
.Cells(Derlgn, 2 + C) = Tabtemp(L, C)
End If
Next
End If
Else
Libelle_Transfert = "Invendu"
End If
Next
End With
Tabtemp = ""
Application.ScreenUpdating = True

End Sub

 

[Bernard_XLD]

Re : Garder la formule "DECALER"

je ne l'ai pas précisé mais tu peux entrer tous tes vendus et tous tes invendus d'un coup, la macro les traitera !
Sur l'original, tu faisais apparemment du coup par coup

A+

 

[la croisée des pains]

Re : Garder la formule "DECALER"

un grand merci Yeahou,
j'ai tester et tout marche ...

encore merci de ton aide

bonne journée
laurent

 

[Bernard_XLD]

Re : Garder la formule "DECALER"

de rien, si je passe au Mans, je viendrai prendre un croissant !

A+

 

[la croisée des pains]

Re : Garder la formule "DECALER"

pas de problème, je suis en train de commencer les chocolats pour Noël
sa approche vite même trop vite...
@+