Problème macro extraction de données Excel

benadry

XLDnaute Occasionnel
Bonjour le forum,

Je suis en train de finaliser une macro qui permet d'extraire des données d'un classeur Excel vers un autre sous condition.

Tout fonctionne parfaitement, sauf que la macro copie indifféremment toutes les lignes que les conditions soient respectées ou pas.

En fait, ce que je souhaite, c'est que la ligne soit copiée systématiquement SAUF si la valeur de la colonne R est égale à 0 OU si la valeur de la colonne V est égale à RLC.

Voici mon code :

Code:
Sub ExtraireDonnees()

' Définition des constantes et des variables
Const FolderSource As String = "G:\CPT\...\Suivi des notifications d'indus\Journées\"
Const FolderCible As String = "G:\CPT\...\Suivi des notifications d'indus\"
Const FileNameCible As String = "Liste des indus créés à compter de 052013.xlsm"
Const SheetSource As String = "A"
Const SheetCible As String = "Total des indus non soldés"
Dim wkbSource, wkbCible As Workbook, shSource, shCible As Worksheet
Dim Lig As Long, nbrLig As Long, NumLig As Long
Dim Col As String, Ext As String, Nom As String

Nom = ThisWorkbook.Sheets(1).Range("G6").Value
Ext = ".xls"

Set wkbSource = Workbooks.Open(FolderSource & Nom & Ext)

' Renommer la 1ère feuille du fichier wkbSource en "A"
wkbSource.Sheets(1).Name = "A"

' Changement du format de la colonne R du fichier wbkSource
Columns("R:R").Select
Selection.NumberFormat = "0.00"
Range("R1").Select
Selection.NumberFormat = "General"

' Ouverture du fichier et de la feuille cibles : Total des indus non soldés de Liste des indus créés à compter de 052013.xlsm
Set wkbCible = Workbooks.Open(FolderCible & FileNameCible)
Set shCible = wkbCible.Worksheets("Total des indus non soldés")
Set shSource = wkbSource.Worksheets("A")

NumLig = 1

With shSource
nbrLig = .Range("R" & .Rows.Count).End(xlUp).row
nbrLig = .Range("W" & .Rows.Count).End(xlUp).row
For Lig = 2 To nbrLig
If .Cells(Lig, "R").Value <> 0 Or .Cells(Lig, "V").Value <> "RLC" Then
.Range("A" & Lig & ":W" & Lig).Copy
Range("A65000").End(xlUp).Offset(1).Select
shCible.Paste
End If
Next
End With

End Sub


Pour vous faire gagner du temps, la ligne qui pose problème est celle-ci :

Code:
If .Cells(Lig, "R").Value <> 0 Or .Cells(Lig, "V").Value <> "RLC" Then

J'ai passé pas mal de temps sur des forums et, d'après ce que j'ai vu, la question est toujours traitée dans le sens où la valeur de la colonne est égale à quelque chose, pas quand elle est différente.

Si quelqu'un pouvait y regarder.

Merci d'avance.

Bien cordialement.
 

Membres actuellement en ligne

Statistiques des forums

Discussions
286 547
Messages
1 877 057
Membres
160 560
dernier inscrit
jesaispas
Haut Bas