Sub TransfertArchCommande1()
Dim Wb1 As Workbook
Dim WB2 As Workbook
Dim Plg As Range, Derlgin As Long
If Range("AE63") = 0 Then '1ère zone à archiver, dans feuille "Archives"
MsgBox "Aucune denrée saisie....", , "Erreur"
Exit Sub
End If
Application.ScreenUpdating = False
Set Wb1 = ThisWorkbook
Set WB2 = Workbooks.Open("C:\ARCHIVES COMMANDES\ArchivesBonsCommandes.xls") '.xlsx si excel 2010
Set Plg = Wb1.Sheets("Bon de Commande").Range("Q63:IT63")
With WB2.Sheets("Archives")
derlign = .Range("B65536").End(xlUp).Row
.Range("IF" & derlign + 1) = "Sauvegarde du " & Format(Date, "dd-mm-yyyy") & " à " & Time
Dim i
With .Range("B" & derlign + 1).Resize(Plg.Rows.Count, 238)
.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("B:IF").AutoFit
End With
'j'ai essayé de faire ça...
If Range("Q65") = "" Then '2ème zone à archiver, même classeur mais dans feuille "Archives."
WB2.Save ' la, si Q65 égal blanc, on sauve et ferme le classeur ???
WB2.Close
Exit Sub
End If
Set Plg = Wb1.Sheets("Bon de Commande").Range("Q65:CI65") 'sinon on traite...
With WB2.Sheets("Archives.")
derlign = .Range("B65536").End(xlUp).Row
.Range("BU" & derlign + 1) = "Sauvegarde du " & Format(Date, "dd-mm-yyyy") & " à " & Time
With .Range("B" & derlign + 1).Resize(Plg.Rows.Count, 71)
.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("B:BT").AutoFit
End With
WB2.Save
WB2.Close
Application.ScreenUpdating = True
End Sub