XL 2013 VBA COPIER COLLER SOUS CONDITION

BENAM69

XLDnaute Occasionnel
Bonjour à tous,

Je suis novice en VBA, je cherche à automatiser une recherche, selon les conditions, il va copier coller les informations dont j'ai besoin sur un autre onglet.

Je vous remercie par avance pour votre aide et en espérant que j'arriverai à m'apporter une solution à mon problème.

Voici l'explication :
Sur le premier onglet :
Sur la plage définie [D5:O15]
SI sur la colonne D "Opérateur 1"/ Première ligne n°5 il détecte le chiffre 1 (cela signifie que l'opérateur 1 va devoir aller en formation) ALORS il va sur colonne B "Activite" pour voir de quelle activité il s'agit suivant la ligne en question. Une fois qu'il a détecté cela, il va aller sur le deuxième onglet pour faire un copié collé des informations suivantes selon la cellule dédiée.
J'aurai donc comme information sur le deuxieme onglet:
A3 : Opérateur 1
B3 : Production "Récupère en cellule B3 dans le premier onglet"
C3 : Coulée "Récupère sur la colonne B le nom de l'activité"
D3 : 20.11.2018 "Récupère la date de formation sur la colonne E du premier onglet"
E3 : 20.01.2019 "Additionne la durée de formation avec la date de formation, il vérifiera si c'est en mois ou en semaine ou en jour pour ajouter correctement la durée"
F3 : 20.03.2019 "Ajoute la prochaine date de formation, c'est à dire la date de fin + la durée du Tournus que l'on trouve en colonne R du premier onglet ( il vérifiera si la période est en mois, en semaine ou en jour sur la colonne S)

Une fois terminée, il répète la même chose sauf qu'il comparera les informations de la première boucle avant de copié collé sur l'autre onglet :
Sur le premier onglet, il détecte le deuxième chiffre 1 (ligne 6) sur la colonne B " Opérateur 1", si les informations Colonne B : "Activite" / Colonne P : "Durée de formation" / Colonne Q : "Périodes" / Colonne E : "Date de formation" sont identiques au premier copié collé alors il ne fait rien. Si une des informations est différentes alors il copie colle de la même manière.

A chaque fois, il vérifie les informations de ce qu'il a collé pour éviter d'avoir un doublon sur le deuxième onglet.

Une fois qu'il a terminé avec l'opérateur 1, il fait de même avec l'opérateur 2 et ainsi de suite. Je précise la plage des opérations de la macro vérifient les informations a partir de la plage [B3:S15]

En tout cas, je remercie grandement les personnes qui m'aideront à résoudre mon problème.

Je vous mets en pièce jointe le fichier en question pour mieux comprendre

Bien à vous
 

Pièces jointes

  • Test de formation.xlsx
    10.7 KB · Affichages: 35
Dernière édition:

BENAM69

XLDnaute Occasionnel
Regarde si c'est mieux là.

C'est normal les dates vides ?

PS : la macro doit être lancée depuis l'onglet usinage

Euh... ce n'est pas normal les dates vides sur l'onglet SUIVI DE FORMATION. Normalement, s'il n'y a pas de date et pas de numéro 1 sur la colonne NIVEAU, il ne copie colle rien.
Mais sinon c'est bien cela que je veux ^^ avec SI cellule vide (Niveau et Date de formation) = Rien faire ^^

C'est noté, onglet usinage ^^.
PS : Dans mon fichier excel original, j'ai un autre onglet avant FORMATION USINAGE et après l'onglet SUIVI DE FORMATION (au total 4 onglets). Est-ce problématique ?
J'aurai 7 fichiers identiques à celui-ci, il me faudrait changer que le nom de l'onglet FORMATION USINAGE à FORMATION LAMINAGE, FORMATION FONDERIE etc ... et ainsi de suite. Si je change que le nom ActiveWorkbook.Sheets dans ton code c'est bon non ? avec évidement une adaptation des autres cellules.

Merci en tout cas ^^
 

Johan

XLDnaute Occasionnel
Re,

MAJ avec la condition qui vérifie bien niveau ET date de formation sont non-vides :

Code:
Sub CopierColler()

Dim lastLine As Long
lastLine = ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A3").End(xlUp).Row + 1

ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A3:G3" & lastLine).ClearContents

'FONDERIE
For Each cell_TableauFonderie In Range("D7:D10, F7:F10, H7:H10, J7:J10, L7:L10, N7:N10, P7:P10, R7:R10, T7:T10, V7:V10, X7:X10")
   
    If cell_TableauFonderie = 1 And cell_TableauFonderie.Offset(0, 1) <> "" Then
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A" & lastLine) = Cells(cell_TableauFonderie.Row, 3) 'PROGRAMME DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("B" & lastLine) = Cells(5, cell_TableauFonderie.Column + 1) 'OPERATEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("C" & lastLine) = Cells(5, 2) 'SECTEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("D" & lastLine) = Cells(cell_TableauFonderie.Row, 2) 'ACTIVITE
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("E" & lastLine) = cell_TableauFonderie.Offset(0, 1) 'DATE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("F" & lastLine) = cell_TableauFonderie.Offset(0, 1) + Cells(cell_TableauFonderie.Row, 26) 'DATE DE FORMATION + DUREE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("G" & lastLine) = cell_TableauFonderie.Offset(0, 1) + Cells(cell_TableauFonderie.Row, 26) + Cells(cell_TableauFonderie.Row, 28) 'DATE DE FIN + TOURNUS
    lastLine = lastLine + 1
    End If
  
Next cell_TableauFonderie

'LAMINAGE
For Each cell_TableauLaminage In Range("D48:D50, F48:F50, H48:H50, J48:J50, L48:L50, N48:N50, P48:P50, R48:R50, T48:T50, V48:V50, X48:X50")
   
    If cell_TableauLaminage = 1 And cell_TableauLaminage.Offset(0, 1) <> "" Then
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A" & lastLine) = Cells(cell_TableauLaminage.Row, 3) 'PROGRAMME DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("B" & lastLine) = Cells(5, cell_TableauLaminage.Column + 1) 'OPERATEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("C" & lastLine) = Cells(46, 2) 'SECTEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("D" & lastLine) = Cells(cell_TableauLaminage.Row, 2) 'ACTIVITE
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("E" & lastLine) = cell_TableauLaminage.Offset(0, 1) 'DATE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("F" & lastLine) = cell_TableauLaminage.Offset(0, 1) + Cells(cell_TableauLaminage.Row, 26) 'DATE DE FORMATION + DUREE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("G" & lastLine) = cell_TableauLaminage.Offset(0, 1) + Cells(cell_TableauLaminage.Row, 26) + Cells(cell_TableauLaminage.Row, 28) 'DATE DE FIN + TOURNUS
    lastLine = lastLine + 1
    End If

Next cell_TableauLaminage

End Sub


PS : Dans mon fichier excel original, j'ai un autre onglet avant FORMATION USINAGE et après l'onglet SUIVI DE FORMATION (au total 4 onglets). Est-ce problématique ?

Tu peux avoir 50 onglets, ca marcherait quand même tant que le nom dans le code correspond au nom de la feuille dans ton classeur.

J'aurai 7 fichiers identiques à celui-ci, il me faudrait changer que le nom de l'onglet FORMATION USINAGE à FORMATION LAMINAGE, FORMATION FONDERIE etc ... et ainsi de suite. Si je change que le nom ActiveWorkbook.Sheets dans ton code c'est bon non ? avec évidement une adaptation des autres cellules.

Oui il suffira de changer les noms des feuilles et l'adresse des cellules si elles sont différentes.
 

BENAM69

XLDnaute Occasionnel
Re,

MAJ avec la condition qui vérifie bien niveau ET date de formation sont non-vides :

Code:
Sub CopierColler()

Dim lastLine As Long
lastLine = ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A3").End(xlUp).Row + 1

ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A3:G3" & lastLine).ClearContents

'FONDERIE
For Each cell_TableauFonderie In Range("D7:D10, F7:F10, H7:H10, J7:J10, L7:L10, N7:N10, P7:P10, R7:R10, T7:T10, V7:V10, X7:X10")
  
    If cell_TableauFonderie = 1 And cell_TableauFonderie.Offset(0, 1) <> "" Then
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A" & lastLine) = Cells(cell_TableauFonderie.Row, 3) 'PROGRAMME DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("B" & lastLine) = Cells(5, cell_TableauFonderie.Column + 1) 'OPERATEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("C" & lastLine) = Cells(5, 2) 'SECTEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("D" & lastLine) = Cells(cell_TableauFonderie.Row, 2) 'ACTIVITE
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("E" & lastLine) = cell_TableauFonderie.Offset(0, 1) 'DATE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("F" & lastLine) = cell_TableauFonderie.Offset(0, 1) + Cells(cell_TableauFonderie.Row, 26) 'DATE DE FORMATION + DUREE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("G" & lastLine) = cell_TableauFonderie.Offset(0, 1) + Cells(cell_TableauFonderie.Row, 26) + Cells(cell_TableauFonderie.Row, 28) 'DATE DE FIN + TOURNUS
    lastLine = lastLine + 1
    End If
 
Next cell_TableauFonderie

'LAMINAGE
For Each cell_TableauLaminage In Range("D48:D50, F48:F50, H48:H50, J48:J50, L48:L50, N48:N50, P48:P50, R48:R50, T48:T50, V48:V50, X48:X50")
  
    If cell_TableauLaminage = 1 And cell_TableauLaminage.Offset(0, 1) <> "" Then
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("A" & lastLine) = Cells(cell_TableauLaminage.Row, 3) 'PROGRAMME DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("B" & lastLine) = Cells(5, cell_TableauLaminage.Column + 1) 'OPERATEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("C" & lastLine) = Cells(46, 2) 'SECTEUR
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("D" & lastLine) = Cells(cell_TableauLaminage.Row, 2) 'ACTIVITE
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("E" & lastLine) = cell_TableauLaminage.Offset(0, 1) 'DATE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("F" & lastLine) = cell_TableauLaminage.Offset(0, 1) + Cells(cell_TableauLaminage.Row, 26) 'DATE DE FORMATION + DUREE DE FORMATION
    ActiveWorkbook.Sheets("SUIVI DE FORMATION").Range("G" & lastLine) = cell_TableauLaminage.Offset(0, 1) + Cells(cell_TableauLaminage.Row, 26) + Cells(cell_TableauLaminage.Row, 28) 'DATE DE FIN + TOURNUS
    lastLine = lastLine + 1
    End If

Next cell_TableauLaminage

End Sub




Tu peux avoir 50 onglets, ca marcherait quand même tant que le nom dans le code correspond au nom de la feuille dans ton classeur.



Oui il suffira de changer les noms des feuilles et l'adresse des cellules si elles sont différentes.

BIINNNGGGOOOO !!! Ca marche du tonnerre !!!!

Merci beaucoup Johan !! Quelle merveille ton code ^^
C'est parfait, en espérant qu'on ne me dit pas de changer encore le format visuel du tableau mais il n'y a pas de risque c'est validé hihi
En tout cas, je te souhaite que du bonheur et merci beaucoup !!!!!
 

Discussions similaires

Réponses
11
Affichages
544

Statistiques des forums

Discussions
314 762
Messages
2 112 615
Membres
111 620
dernier inscrit
emermet