Christian0258
XLDnaute Accro
Bonjour à tout le forum,
Je souhaiterais votre aide pour me dire ce qu'il faudrai ajouter à ce code pour que l'archivage écrase les données existantes de la feuille destinataire...autrement dit chaque archivage remplace des données...
Sub TransfertVersTraitementCommandes()
Dim Wb1 As Workbook
Dim WB2 As Workbook
Dim Plg As Range, Derlgin As Long
If Range("B2") = 0 Then
MsgBox "Aucune denrée saisie....", , "Erreur"
Exit Sub
End If
Application.ScreenUpdating = False
Set Wb1 = ThisWorkbook
Set WB2 = Workbooks.Open("C:\ARCHIVES DONNEES FICHES TECHNIQUES\Traitement Commandes.xls") '.xlsx si excel 2010
Set Plg = Wb1.Sheets("Ingrédients").Range("B2:O" & Wb1.Sheets("Ingrédients").Range("O1000").End(xlUp).Row)
With WB2.Sheets("Base denrées")
derlign = .Range("A65536").End(xlUp).Row
.Range("O" & derlign + 1) = "Base denrées du " & Format(Date, "dd-mm-yyyy") & " à " & Time
Dim i
With .Range("A" & derlign + 1).Resize(Plg.Rows.Count, 14)
.Value = Plg.Value
For i = Plg.Rows.Count To 1 Step -1
If Application.CountA(.Rows(i)) = 0 Then .Rows(i).Delete xlUp
Next
End With
.Columns("A:O").AutoFit
End With
WB2.Save
WB2.Close
Application.ScreenUpdating = True
End Sub
Merci pour votre aide.
Bien amicalement,
Christian
Je souhaiterais votre aide pour me dire ce qu'il faudrai ajouter à ce code pour que l'archivage écrase les données existantes de la feuille destinataire...autrement dit chaque archivage remplace des données...
Sub TransfertVersTraitementCommandes()
Dim Wb1 As Workbook
Dim WB2 As Workbook
Dim Plg As Range, Derlgin As Long
If Range("B2") = 0 Then
MsgBox "Aucune denrée saisie....", , "Erreur"
Exit Sub
End If
Application.ScreenUpdating = False
Set Wb1 = ThisWorkbook
Set WB2 = Workbooks.Open("C:\ARCHIVES DONNEES FICHES TECHNIQUES\Traitement Commandes.xls") '.xlsx si excel 2010
Set Plg = Wb1.Sheets("Ingrédients").Range("B2:O" & Wb1.Sheets("Ingrédients").Range("O1000").End(xlUp).Row)
With WB2.Sheets("Base denrées")
derlign = .Range("A65536").End(xlUp).Row
.Range("O" & derlign + 1) = "Base denrées du " & Format(Date, "dd-mm-yyyy") & " à " & Time
Dim i
With .Range("A" & derlign + 1).Resize(Plg.Rows.Count, 14)
.Value = Plg.Value
For i = Plg.Rows.Count To 1 Step -1
If Application.CountA(.Rows(i)) = 0 Then .Rows(i).Delete xlUp
Next
End With
.Columns("A:O").AutoFit
End With
WB2.Save
WB2.Close
Application.ScreenUpdating = True
End Sub
Merci pour votre aide.
Bien amicalement,
Christian