Copier des lignes sous conditions

Question

J'ai un gros problème pour copier des cellules d'un classeur sur un autre. Je veux recopier certaines cellules d'une ligne dans un autre fichier, uniquement si une certaine cellule est remplie. Voilà 5 jours que je passe la journée entière a chercher des exemples similaires mais je ne trouve pas. Si quelqu'un pouvais m'aider Merci Zyglur38...

ThauThème · Accepted Answer

Re,

Essaie comme ça :

Sub ExportHeuresVersIndic()
Dim madate As Date, annee As String, mois As String, vendredi As Date, semaine As String, qui As String 'déclare les variables madate, annee, mois, vendredi, semaine et qui
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim zoneproj As Range 'déclare la variable zoneproj (Zone Projet)
Dim zonehorsproj As Range 'déclare la variable zonehorsproj (Zone Hors Projet)
Dim zoneabsence As Range 'déclare la variable zoneabsence (Zone Absence)
Dim ZT As Range 'déclare la variable ZT (Zone Total)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim PLV As Long 'déclare la variable PLV (Première ligne vide)

Set CD = Workbooks("INDICATEUR.XLSM") 'définit le classeur destination CD
Set OD = CD.Worksheets("BDD") 'définit l'onglet destination OD
Set OS = ActiveSheet 'définit l'onglet source OS
annee = OS.Range("C4").Value 'définit l'annee
madate = OS.Range("J6") 'définit madate
mois = Format(madate, "mmmm") 'définit mois
vendredi = OS.Range("J6") 'définit vendredi
semaine = ActiveSheet.Name 'définit semaine
qui = OS.Range("J3").Value 'définit qui

Set zoneproj = OS.Range("C15:M21") 'définit zoneproj
Set zonehorsproj = OS.Range("C22:M35") 'définit zonehorsproj
Set zoneabsence = OS.Range("C36:M39") 'définit zoneabsence
Set ZT = OS.Application.Intersect(OS.Application.Union(zoneproj, zonehorsproj, zoneabsence), OS.Columns(13)) 'définit ZT
For Each CEL In ZT 'boucle sur toutes les cellule CEL de la plage ZT
    If CEL.Value <> 0 Then 'condition 1 : si la cellule n'est pas nulle
        PLV = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la première ligne vide PLV de la colonne A de l'onglet OD
        OD.Cells(PLV, "A").Value = annee 'renvoie année dans la cellule ligne PLV colonne A
        OD.Cells(PLV, "B").Value = mois 'renvoie mois dans la cellule ligne PLV colonne B
        OD.Cells(PLV, "C").Value = Format(vendredi, "dd/mm/yyyy") 'renvoie vendredi dans la cellule ligne PLV colonne C
        OD.Cells(PLV, "D").Value = semaine 'renvoie semaine dans la cellule ligne PLV colonne D
        OD.Cells(PLV, "E").Value = qui 'renvoie qui dans la cellule ligne PLV colonne E
        If Not Application.Intersect(CEL, zoneproj) Is Nothing Then 'condition 2 : si CEL se trouve dans la plage zoneproj
            OD.Cells(PLV, "F").Value = OS.Cells(CEL.Row, "C") 'renvoie l'affectation ou client dans la cellule ligne PLV colonne F
            OD.Cells(PLV, "G").Value = OS.Cells(CEL.Row, "D") 'renvoie le libellé dans la cellule ligne PLV colonne G
            OD.Cells(PLV, "I").Value = OS.Cells(CEL.Row, "M") 'renvoie le total dans la cellule ligne PLV colonne I
        End If 'fin de la condition 2
        If Not Application.Intersect(CEL, zonehorsproj) Is Nothing Then 'condition 3 : si CEL se trouve dans la plage zonehorsproj
            OD.Cells(PLV, "J").Value = OS.Cells(CEL.Row, "C") 'renvoie l'affectation ou client dans la cellule ligne PLV colonne J
            OD.Cells(PLV, "K").Value = OS.Cells(CEL.Row, "D") 'renvoie le libellé dans la cellule ligne PLV colonne K
            OD.Cells(PLV, "L").Value = OS.Cells(CEL.Row, "M") 'renvoie le total dans la cellule ligne PLV colonne L
        End If 'fin de la condition 3
        If Not Application.Intersect(CEL, zoneabsence) Is Nothing Then 'condition 4 : si CEL se trouve dans la plage zoneabsence
            OD.Cells(PLV, "M").Value = OS.Cells(CEL.Row, "C") 'renvoie l'affectation ou client dans la cellule ligne PLV colonne M
            OD.Cells(PLV, "N").Value = OS.Cells(CEL.Row, "M") 'renvoie le total dans la cellule ligne PLV colonne N
        End If 'fin de la condition3
    End If 'fin de la condition 1
Next CEL 'prochane cellule de la plage
End Sub

ThauThème · Answer

Bonjour Zyglur, bonjour le forum,

On pourrait t'aider si tu daignais nous donner le renseignements nous permettant de le faire :
- Nom et chemin d'accès des deux classeurs (source et destination)
- Nom des onglets de deux classeurs (source et destination)
- Colonne (source) référente qui permet de copier ou pas la ligne
- Ligne de départ où seront copiées les données.

Après ça sera beaucoup plus facile et on ne perdra pas de temps inutilement à adapter à ton projet...