VBA copier coller vers plusieurs feuilles excel

Résolu
dédé65000 Messages postés 11 Date d'inscription   Statut Membre Dernière intervention   -  
 foo -
Bonjour à tous,

Je suis débutant en VBA et j'ai un problème avec une macro que je tente de créer.
En fait je souhaite archiver des données d'une feuille ("A") qui contient le gestion de divers équipement
vers plusieurs autres feuilles ("C") et ("D") en fonction de la référence.
Ainsi au départ seule la feuille A est rempli et elle contient des références pour chacun des équipements à gérer. Je souhaiterais copier chacun de ces équipements soit dans la feuille "C" si la référence de l'équipement commence par CCC soit dans la feuille "D" si la référence de l'équipement commence par DDD.

A savoir que la feuille a sera régulier vidé puis reremplit manuellement mais cela ne doit pas venir écraser les données archiver feuille "C" et "D".


J'ai utilisé ce code pour archiver sans écraser les données de la feuille "A" vers la feuille "B"

Sub TEST()
Sheets("A").Activate
Range("A9").CurrentRegion.Select
Selection.Copy
Sheets("B").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End Sub

Maintenant je n'arrive pas à copier les données dans des feuilles différentes selon leur référence

Quelqu'un pourrait-il me conseiller ? merci d'avance de votre aide
A voir également:

5 réponses

dédé65000 Messages postés 11 Date d'inscription   Statut Membre Dernière intervention   1
 
1
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour

pour essayer d'^tre efficace:


mettre le classeur sans données confidentielles en pièce jointe sur
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse

0
foo
 
Bonjour

Voila ta macro modifier

Sub TestA()
Nlig = Range("A" & Rows.Count).End(xlUp).Row
Lig1 = Sheets("C").Range("A" & Rows.Count).End(xlUp).Row
Lig2 = Sheets("D").Range("A" & Rows.Count).End(xlUp).Row
For L = 8 To Nlig
Sh = Range("A" & L).Value
If Sh <> "" Then
Select Case Sh
Case "C"
Lig1 = Lig1 + 1
Lig = Lig1
Case "D"
Lig2 = Lig2 + 1
Lig = Lig2
End Select
Rows(L).Copy
Sheets(Sh).Range("A" & Lig).PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
End Sub

A+
Maurice
0
dédé65000 Messages postés 11 Date d'inscription   Statut Membre Dernière intervention   1
 
Génial c'est exactement ce que je voulais merci beaucoup

Bonne continuation
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
foo
 
Bonjour

Comme ca ses mieux

Sub Test()
Application.ScreenUpdating = False
Nlig = Range("A" & Rows.Count).End(xlUp).Row
Lig1 = Sheets("C").Range("A" & Rows.Count).End(xlUp).Row
Lig2 = Sheets("D").Range("A" & Rows.Count).End(xlUp).Row
For L = Nlig To 8 Step -1
Sh = Range("A" & L).Value
If Sh <> "" Then
Select Case Sh
Case "C"
Lig1 = Lig1 + 1
Lig = Lig1
Case "D"
Lig2 = Lig2 + 1
Lig = Lig2
End Select
Rows(L).Copy
Sheets(Sh).Range("A" & Lig).PasteSpecial xlPasteValues
Rows(L).Delete
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

A+
Maurice
0