Copier/Coller sur une autre feuille

[Babboo]

Bonjour à tous excelliens,

Je suis sur un fichier excel d'effectif et je souhaiterias que les opération de copier/colelr se fasse automatiquement sur d'autres feuilles en fonction de critères.

Il vous suffit d'ouvrir le fichier joint je pense avoir bien expliqué. Une seule chose autant que possible, la première colonne restera le nom de l'Atelier. Puis il y aura les info concernant les employés et seulement les dernières colonnes reprendront les spécificités de chacuns d'eux. S'il faut changer alors je vous laisse faire si c'est mieux pour vous.

Merci beaucoup d'avance.

Babboo

 

[Cousinhub]

Re : Copier/Coller sur une autre feuille

Bonjour, regarde le fichier joint.

Sub transfert()
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> "Usine" Then
With sh
.Activate
Select Case sh.Name
Case Is = "SST"
.[L1] = "SST"
.[L2] = "OUI"
Case Is = "ESI"
.[L1] = "ESI"
.[L2] = "OUI"
Case Else
.[L1] = "Atelier"
.[L2] = sh.Name
End Select
Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"L1:L2"), CopyToRange:=Range("A1:H1"), Unique:=False
.[L1] = ""
.[L2] = ""
End With
End If
Next sh
Sheets("Usine").Select
Application.ScreenUpdating = True
End Sub

 

[Robert]

Re : Copier/Coller sur une autre feuille

Bonjour Baboo, bonjour le forum,

En pièce jointe une proposition :

Édition :

Oooops ! Pas frais... Bonjour Bhbh on s'est croisés.

 

[Babboo]

Re : Copier/Coller sur une autre feuille

Re bonjour à tous,

Merci Bhbh et Robert cela correspond tout à fait à mes attentes je n'ai plus qu'à le reprendre en espérant ne pas faire d'erreurs

Encore une fois merci à tous les deux ....

A bientôt

Babboo🙂

 

[Bebere]

Re : Copier/Coller sur une autre feuille

bonjour babboo,Bhbh,Robert
jamais 2 sans 3
emploi de find
à bientôt

 

[Babboo]

Re : Copier/Coller sur une autre feuille

RE bonjour à tous les 3 et à tous les excelliens,

J'espère uqe ovus n'êtes pas trop susceptible. Toutes vos propositions fonctionnent. Celle qui me plaît le plus est celel de Bhbh car lorsque l'on appuie (plusieurs fois) sur le bouton, les lignes identiques ne sont pas répétées.

Par contre, j'avais fait soft dans la présentation de mon fichier mais désormais je dois rajouter des colonnes pour d'autres données et le bouton ne fonctionne plus correctement. Il m'indique un bug.

Les colonnes SST et ESI (les deux dernières colonnes) sont en réalité en colonne R et S et non pas G et H comme dans le fichier joint. Etant une bille en VBA, je continue à chercher mais les spécialistes que vous êtes du VBA iront certainement plus vite que moi.

Désolé encore, je pensais avoir bien fait.

Babboo

 

[Cousinhub]

Re : Copier/Coller sur une autre feuille

Bonjour, remplace le code par celui-ci :

Sub transfert()
Dim pl As Range
Set pl = Range("A1:S" & Range("A65536").End(xlUp).Row)
pl.Name = "base"
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> "Usine" Then
With sh
.Activate
Select Case sh.Name
Case Is = "SST"
.[U1] = "SST"
.[U2] = "OUI"
Case Is = "ESI"
.[U1] = "ESI"
.[U2] = "OUI"
Case Else
.[U1] = "Atelier"
.[U2] = sh.Name
End Select
Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( "U1:U2"), CopyToRange:=Range("A1:H1"), Unique:=False
.[U1] = ""
.[U2] = ""
End With
End If
Next sh
Sheets("Usine").Select
Application.ScreenUpdating = True
End Sub


Edition : attention, la ligne Range("base").Advancer.... sur une seule ligne jusqu'à False

 

[Babboo]

Re : Copier/Coller sur une autre feuille

MERCI SUPER GENIAL

ça fonctionne.

Un grand merci à ceux qui ont travaillé dessus ou qui travailleront dessus poru proposer autre chose. En tout cas ça marche pour moi et c'est parfait.

JE retiens une autre chose, c'est le fait d'être le plus proche de la réalité dans les fichiers que l'on joint....

Merci à tous les excelliens.