VBA copier coller vers plusieurs feuilles excel [Résolu/Fermé]

Signaler
Messages postés
11
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
7 octobre 2014
-
 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

5 réponses

Messages postés
11
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
7 octobre 2014
1
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60825 internautes nous ont dit merci ce mois-ci

Messages postés
16209
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 septembre 2020
3 032
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

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
Messages postés
11
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
7 octobre 2014
1
Génial c'est exactement ce que je voulais merci beaucoup

Bonne continuation
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