Macro pour archiver...petit souci avec la zone à copier

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais, à nouveau votre aide, pour modifier cette macro.

Cette macro archive une zone, vers un autre classeur...

voir fichier

Je vous remercie pour le temps que vous voudrez bien m'accorder.

Bien à vous,
Christian

 

[Guest]

Re : Macro pour archiver...petit souci avec la zone à copier

Bonjour Christian,

Enlève les blancs qui sont dans la colonne AT et qui semblent vides mais ne le sont pas. Et tout fonctionnera

A+

 

[Christian0258]

Re : Macro pour archiver...petit souci avec la zone à copier

Re, le forum, Hasco

Bonsoir à tous,

Merci, Hasco, ça fonctionne.

Bien à vous,
christian

 

[Christian0258]

Re : Macro pour archiver...petit souci avec la zone à copier

Re, le forum,
Je reviens vers vous, pour réitérer ma demande initiale : à savoir modifier la macro pour ne coller que les valeurs et non
les formules.
J'ai par, ailleurs, tenu compte de la remarque de Hasco.

Merci pour votre aide, et le temps que vous voudrez bien m'accorder.
Bien à vous,
Christian

 

[JCGL]

Re : Macro pour archiver...petit souci avec la zone à copier

Bonjour à tous,
Salut Hasco,
Salut Christian,

Peux-tu essayer avec ceci :

Sub Archivage()

    Dim Wb1 As Workbook
    Dim WB2 As Workbook
    Dim Plg As Range, Derlgin As Long
    Dim Cel

    If Range("AT101") = "" Then
        MsgBox "Rien à archiver....", , "Erreur"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set Wb1 = ThisWorkbook
    Set WB2 = Workbooks.Open("C:\Users\Christian\Qtés pour commandes.xls")
    Set Plg = Wb1.Sheets("DIETETIQUE").Range("AT101:AY" & Wb1.Sheets("DIETETIQUE").Range("AT65536").End(xlUp).Row)

    With WB2.Sheets("Archives")
        derlign = .Range("A65536").End(xlUp).Row
        .Range("i" & derlign + 1) = "Sauvegarde du " & Format(Date, "dd-mm-yyyy") & " à " & Time
        Plg.Copy .Range("A" & derlign + 1)
        Cells.Replace What:="0", Replacement:="", LookAt:=xlPart
        .Columns("A:F").AutoFit
    End With

    WB2.Save
    WB2.Close
    'Plg.Clear
    Application.ScreenUpdating = True
End Sub

A+ à tous

 

[Christian0258]

Re : Macro pour archiver...petit souci avec la zone à copier

Re, le foreum, JCGL,

Bonsoir, Jean-Claude j'espère que tu vas bien.

Merci pour ton aide. J'ai une message d'erreur sur :
Cells.Replace What:="0", Replacement:="", LookAt:=xlPart

Mais en fait ce que je souhaiterais c'est un archivage sans les formules, uniquement les valeurs.

Bien à toi,
Christian

 

[Guest]

Re : Macro pour archiver...petit souci avec la zone à copier

Bonsoir Christian,
JC🙂


Voici la partie du code concernée, bien mettre sur des lignes différentes le Plg.Copy et le .range(.....).PasteSpecial xlValues.

    With WB2.Sheets("Archives")
      derlign = .Range("A65536").End(xlUp).Row
      .Range("i" & derlign + 1) = "Sauvegarde du " & Format(Date, "dd-mm-yyyy") & " à " & Time
      Plg.Copy
      .Range("A" & derlign + 1).PasteSpecial xlPasteValues
      .Columns("A:F").AutoFit
    End With

Par contre en voyant le code de l'ami JC, je vois que je n'ai pas compris la même chose à propos des zéro. Tu voulais les enlever dans le classeur Source et le classeur Destination ou les deux.

A+

 

[Christian0258]

Re : Macro pour archiver...petit souci avec la zone à copier

Re, le forum, Hasco,

Hasco, c'est impeccable.
Merci, Hasco, pour le temps que a bien voulu m'accorder.

Bien à vous,
Christian

 

[JCGL]

Re : Macro pour archiver...petit souci avec la zone à copier

Bonjour à tous,

Dans le code, tu as

Dim Plg As Range, Derlgin As Long

qui ensuite devient

derlign = .Range("A65536").End(xlUp).Row

Mais cela n'a pas d'incidence sans le Option Explicit

A+ à tous

 

[Christian0258]

Re : Macro pour archiver...petit souci avec la zone à copier

Bonjour à tout le forum,

Je remercie JCGL, et Hasco qui sont intervenus sur cette macro.

Cette macro copie bien les valeurs et les colle dans un autre classeur…
Sub ArchivageHASCO()

Dim Wb1 As Workbook
Dim WB2 As Workbook
Dim Plg As Range, Derlgin As Long

If Range("AU101") = "" Then
MsgBox "Rien à archiver....", , "Erreur"
Exit Sub
End If

Application.ScreenUpdating = False
Set Wb1 = ThisWorkbook
Set WB2 = Workbooks.Open("C:\Users\Christian\Qtés pour commandes.xls")
Set Plg = Wb1.Sheets("DIETETIQUE").Range("AU101:AZ" & Wb1.Sheets("DIETETIQUE").Range("AU65536").End(xlUp).Row)

With WB2.Sheets("Archives")
derlign = .Range("A65536").End(xlUp).Row
.Range("i" & derlign + 1) = "Sauvegarde du " & Format(Date, "dd-mm-yyyy") & " à " & Time
Plg.Copy
.Range("A" & derlign + 1).PasteSpecial xlPasteValues
.Columns("A:F").AutoFit
End With

WB2.Save
WB2.Close
'Plg.Clear
Application.ScreenUpdating = True

End Sub

Comment éviter la copie des blancs (résultats de formules expl SI(AT101="";"";...), en effet la macro copie et colle la zone AT101:AY201 ce qui donne de nombreuses lignes blanches entre chaque copie dans le classeur cible...

Comment faire pour ne copier que les résultats de formules, donc si c'est différent de "".


Merci pour votre aide.

Bien à vous,
Christian

 

[Guest]

Re : Macro pour archiver...petit souci avec la zone à copier

Bonjour Christian,
JC🙂,

Christian, il vaudrait mieux que tu nous donnes un classeur avec tes formules. Tes explications ne sont pas assez claires. Je pensais que nous avions rélglé le problème dans les posts #2 et #3 où il n'était pas question de formules.

Alors donne nous un classeur avec une feuille telle que tu l'as chez toi, change seulement les données confidentielles.

P.S. utilise l'éditeur Avancé pour poster. Et utilise le bouton '#' sur la barre d'outils pour insérer tes codes

A+