Modif ,sur macro pour archivage, écraser les données à chaque archivage...

[Christian0258]

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

 

[kjin]

Re : Modif ,sur macro pour archivage, écraser les données à chaque archivage...

Bonjour,
Prends la bonne habitude d'encadrer ton code dans des balises

 (# dans le menu)
A vu de nez...
[CODE]
Sub TransfertVersTraitementCommandes()
Dim Wb1 As Workbook, WB2 As Workbook
Dim i#
If Range("B2") = 0 Then
MsgBox "Aucune denrée saisie....", , "Erreur"
Exit Sub
End If
Application.ScreenUpdating = False
Set Wb1 = ThisWorkbook
With Wb1.Sheets("Ingrédients")
    Set Plg = .Range("B2:O" & .Range("O1000").End(xlUp).Row)
End With
Set WB2 = Workbooks.Open("C:\ARCHIVES DONNEES FICHES TECHNIQUES\Traitement Commandes.xls") '.xlsx si excel 2010
With WB2.Sheets("Base denrées")
    .Cells.ClearContents
    .Range("A1") = "Base denrées du " & Format(Date, "dd-mm-yyyy") & " à " & Time
    With .Range("A2").Resize(Plg.Rows.Count, 14)
        .Value = Plg.Value
        For i = Plg.Rows.Count + 1 To 2 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

A+
kjin

 

[Christian0258]

Re : Modif ,sur macro pour archivage, écraser les données à chaque archivage...

Re, le forum, kjin,

ok, message reçu.
Un grand merci pour le boulot.

Bien à toi,
Christian