Copier lignes d'1 autre classeur si condition a et condition b Résolu/Fermé

Question

Bonjour, 

N'ayant jamais programmer en VBA sans réel but autre que de m'amuser à colorier une case ou a copier une cellule, j'ai un peu du mal à mettre en code ce que je souhaite faire.
Je me permets donc de faire appel à vous et vais, pour ce faire, essayer d'être le plus clair possible quant à ma demande :

1. J'ai un premier fichier Excel qui me sert de BD.
2. J'ai un second fichier Excel dans lequel j'aimerai afficher les données selon deux conditions. 


Plus précisément :
- Si lors de la lecture de la case dans la BD, Di = "NA" alors on passe à la lecture de la ligne suivante.
- Si lors de la lecture de la case dans la BD, Di <> "NA" alors on regarde, toujours dans la BD, si Fi ou Gi ou Hi sont coloriées en rouge. Si VRAI alors, on copie la plage "Ai : Hi" de la BD et on la colle dans la dernière plage vide du second fichier et ensuite on passe à la lecture de la ligne suivante de la BD.

Pour éviter des soucis d'addressage, le fichier de BD initial étant sur un serveur, j'essaye d'abord de tester la chose entre 2 feuilles d'un même fichier.

Voilà le bout de code (je n'ai essayé de coder que la dernière partie de ma requête) que j'ai actuellement en ayant glané quelques infos par-ci, par-là...

Sub Bouton4_Cliquer()
    
    Dim nb_lignes As Integer
    
    Sheets("feuil1").Activate
    nb_lignes = WorksheetFunction.CountA(Range("A:A")) 'Equivalent de la fonction NBVAL dans Excel. Permet de prendre en compte automatiquement le nombre de ligne utilisées.
    
    For i = 4 To nb_lignes 'nb_lignes
        If Sheets("feuil1").Range("F" & i).Interior.Color = 255 Or Sheets("feuil1").Range("G" & i).Interior.Color = 255 Or Sheets("feuil1").Range("H" & i).Interior.Color = 255 Then 'Vérifie si une des cases est rouge
            Range("A" & i & ":H" & i).Copy 'copie la plage
            Sheets("feuil2").Activate 'active la feuille dans laquelle Excel va aller coller les données
            'Range("A" & i & ":H" & i).End(xlUp).Offset(1).Select 'recherche la première plage vide de la feuille feuil2
            ActiveSheet.Paste 'colle les données
            Application.CutCopyMode = False '"sort" du coller
        End If
   
 Next

End Sub


Configuration: Windows 7 / Mozilla 11.0

michel_m · Answer

Bonjour
je n'ai pas vu la condition en colonne D <>"NA"...

La couleur est- elle saisie manuellement ou par mise en forme conditionnelle ? 

recopie t' on le format rouge dans le fichier "cible" ?
 
 Michel

michel_m · Answer

Bonjour ouf! tout ces imbrications avec des IF, des AND et des OR pas de la tarte pour commencer la semaine ! ==> un peu moins de cheveux ! nota: j'ai considéré qu'il y a vait du texte dans la cellule A3 feuil2 dans cette feuille2 a toi de faire les MEFC comme les bordures, couleurs etc Option Explicit'------------------------------------------------------Sub recopier_si()Dim Derlig As Integer, T_ok, Cptr As Integer, Col As Byte, T_out, Idx As IntegerDim Ligvid As Integer Application.ScreenUpdating = False 'fige l'écran: confort et rapidité With Sheets(1)'--------mémorisation tableaux Derlig = Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row T_ok = .Range("A4:H" & Derlig) ReDim T_out(1 To UBound(T_ok), 1 To 8)'-------récolte valeurs si conditions remplies For Cptr = 1 To UBound(T_ok) 'd'après mise en forme conditionnelle 'si 'D<>"NA" et A <>0 et _ G=5 ou _ F="" ou _ H="" et A<>"NA" et C<>1 et E<>0 et E<>"PF" et E <>"I" If T_ok(Cptr, 4) <> "NA" Then If T_ok(Cptr, 1) <> 0 Then If T_ok(Cptr, 7) = 5 Or T_ok(Cptr, 6) = "" Or _ T_ok(Cptr, 8) = "" And T_ok(Cptr, 1) <> "NA" And T_ok(Cptr, 3) <> 1 And _ T_ok(Cptr, 5) <> 0 And T_ok(Cptr, 5) <> "PF" And T_ok(Cptr, 5) <> "I" Then 'mémorisation valeurs A à H Idx = Idx + 1 For Col = 1 To 8 T_out(Idx, Col) = T_ok(Cptr, Col) Next Col End If End If End If Next Cptr End With'---------restitution With Sheets(2) Ligvid = .Columns("A").Find("", .Range("A3")).Row .Cells(Ligvid, "A").Resize(UBound(T_out), 8) = T_out .Activate End WithEnd Sub

Copier lignes d'1 autre classeur si condition a et condition b

2 réponses

Discussions similaires