Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

Christian0258 · 17 Février 2013

Re, Bonsoir à tout le forum,

J'ai à nouveau besoin d'aide sur lune macro ci-dessous.
Cette macro archive une zone définie vers un autre classeur.
Mon problème :
-comment modifier pour n'archiver que les valeurs
- et n'archiver que les lignes renseignées et non les lignes vides :

Merci pour votre aide si précieuse.
Bien à vous,
Christian

Sub TransfertQtéFicheTechn()
Dim Wb1 As Workbook
Dim WB2 As Workbook
Dim Plg As Range, Derlgin As Long
If Range("g3") = 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\DonnéesFichesTechniques.xls.xlsx")
Set Plg = Wb1.Sheets("FICHE TECHNIQUE").Range("CK17:CU" & Wb1.Sheets("FICHE TECHNIQUE").Range("CK32").End(xlUp).Row)
With WB2.Sheets("Archives")
derlign = .Range("A65536").End(xlUp).Row
.Range("M" & derlign + 1) = "Sauvegarde du " & Format(Date, "dd-mm-yyyy") & " à " & Time
Plg.Copy .Range("A" & derlign + 1) 'comment modifier pour ne copier que les valeurs et sans lignes vides
.Columns("A:L").AutoFit
End With
WB2.Save
WB2.Close
Application.ScreenUpdating = True
End Sub

job75 · 17 Février 2013

Re : Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

Bonsoir Christian,

Remplacer :

Code:

Plg.Copy .Range("A" & derlign + 1)

par :

Code:

Dim i
With .Range("A" & derlign + 1).Resize(Plg.Rows.Count, 11)
  .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

Bien entendu pas testé.

A+

kjin · 17 Février 2013

Re : Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

bonsoir,

Code:

Sub TransfertQtéFicheTechn()
Dim wB1 As Workbook, wB2 As Workbook
Dim Plg As Range, dL As Long
If Range("g3") = 0 Then
    MsgBox "Aucune denrée saisie....", , "Erreur"
    Exit Sub
End If
Application.ScreenUpdating = False
Set wB1 = ThisWorkbook
With wB1.Sheets("FICHE TECHNIQUE")
    Set Plg = .Range("CK17:CU" & .Range("CK32").End(xlUp).Row)
End With
Set wB2 = ("C:\ARCHIVES DONNEES FICHES TECHNIQUES\DonnéesFichesTechniques.xls.xlsx")
With wB2.Sheets("Archives")
    dL = .Range("A65536").End(xlUp).Row + 1
    .Range("M" & dL) = "Sauvegarde du " & Format(Date, "dd-mm-yyyy") & " à " & Time
    For i = 1 To Plg.Rows.Count
        If Application.CountA(Plg.Rows(i)) <> 0 Then
            dL = dL + 1
            .Range("A" & dL).Resize(1, Plg.Columns.Count) = Plg.Rows(i).Value
        End If
    Next
    .Columns("A:L").AutoFit
End With
wB2.Close True
Application.ScreenUpdating = True
End Sub

A+
kjin

Christian0258 · 17 Février 2013

Re : Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

Re, le forum, job75,

Bonsoir, job75, merci pour le code, je teste et te dis.

Bien à toi,
Bonne soirée.
Christian

Oups pas vu , kjin, merci beaucoup à vous deux...

job75 · 17 Février 2013

Re : Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

Bonsoir kjin,

Ton code va bien si dans la plage Plg il n'y a pas des formules renvoyant le texte vide "".

A+

Christian0258 · 18 Février 2013

Re : Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

Re, le forum,kjin et job75,

Après essais vos codes fonctionnent parfaitement.

Merci à nouveau.
Bien à vous,
Christian
N.B bien noté la remarque, post 5, de job75

kjin · 18 Février 2013

Re : Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

bonjour,

job75 à dit:
Ton code va bien si dans la plage Plg il n'y a pas des formules renvoyant le texte vide "".

bien d'accord mais dans tous les il faudrait tester qu'il existe au moins une constante dans la ligne !
A+
kjin

Modif ,sur macro pour archiver les valeurs d'une zone et sans lignes vides...

Christian0258

XLDnaute Accro

job75

XLDnaute Barbatruc

kjin

XLDnaute Barbatruc

Christian0258

XLDnaute Accro

job75

XLDnaute Barbatruc

Christian0258

XLDnaute Accro

kjin

XLDnaute Barbatruc

Discussions similaires